Tangent-linear Code for Shallow Water Model
We show the tangent linear code as well as the
driver code that is used to call the transformed
top-level routine correctly.
Tangent-linear Code
C ***********************************************************
C Fortran file translated from WHIRL Thu Sep 16 17:28:12 2004
C ***********************************************************
C ***********************************************************
MODULE adsize
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Global Variables ****
C
type(active) :: ADXC(1 : 6200)
SAVE ADXC
INTEGER(w2f__i4) NC
SAVE NC
type(active) :: XC(1 : 6200)
SAVE XC
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) NCMAX
PARAMETER ( NCMAX = 6200)
C
C **** statements ****
C
END MODULE
MODULE size
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) NX
PARAMETER ( NX = 20)
INTEGER(w2f__i4) NY
PARAMETER ( NY = 20)
C
C **** statements ****
C
END MODULE
MODULE parms
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Global Variables ****
C
type(active) :: AH
SAVE AH
type(active) :: BETA
SAVE BETA
LOGICAL(w2f__i4) CALC_HESS
SAVE CALC_HESS
LOGICAL(w2f__i4) CARTESIAN
SAVE CARTESIAN
CHARACTER(80) DEPTHFILE
SAVE DEPTHFILE
type(active) :: DT
SAVE DT
type(active) :: DT_DUMP
SAVE DT_DUMP
CHARACTER(80) ETAINIFILE
SAVE ETAINIFILE
type(active) :: F0
SAVE F0
CHARACTER(80) FORCINGFILE
SAVE FORCINGFILE
CHARACTER(80) FOUTNAME
SAVE FOUTNAME
LOGICAL(w2f__i4) FULLIO
SAVE FULLIO
LOGICAL(w2f__i4) GRAD_CHECK
SAVE GRAD_CHECK
LOGICAL(w2f__i4) INITIAL_GRAD
SAVE INITIAL_GRAD
INTEGER(w2f__i4) ITERATION
SAVE ITERATION
CHARACTER(80) NCDATAFILE
SAVE NCDATAFILE
CHARACTER(80) NCRESTARTFILE
SAVE NCRESTARTFILE
INTEGER(w2f__i4) NT
SAVE NT
INTEGER(w2f__i4) NTSPINUP
SAVE NTSPINUP
type(active) :: OM
SAVE OM
LOGICAL(w2f__i4) OPTIMIZE
SAVE OPTIMIZE
LOGICAL(w2f__i4) QUADFRIC
SAVE QUADFRIC
type(active) :: RINI
SAVE RINI
CHARACTER(80) RUNNAME
SAVE RUNNAME
LOGICAL(w2f__i4) SPHERICAL
SAVE SPHERICAL
type(active) :: START_TIME
SAVE START_TIME
LOGICAL(w2f__i4) SUPPRESSIO
SAVE SUPPRESSIO
CHARACTER(80) UINIFILE
SAVE UINIFILE
CHARACTER(80) VINIFILE
SAVE VINIFILE
LOGICAL(w2f__i4) XPERIODIC
SAVE XPERIODIC
type(active) :: XSTART
SAVE XSTART
LOGICAL(w2f__i4) YPERIODIC
SAVE YPERIODIC
type(active) :: YSTART
SAVE YSTART
C
C **** Local Variables and functions ****
C
REAL(w2f__4) DEG2RAD
PARAMETER ( DEG2RAD = 0.01745329)
REAL(w2f__4) EARTH
PARAMETER ( EARTH = 6371000.)
REAL(w2f__4) G
PARAMETER ( G = 9.810000)
REAL(w2f__4) INVRHO0
PARAMETER ( INVRHO0 = 0.0009727626)
REAL(w2f__4) PI
PARAMETER ( PI = 3.141593)
REAL(w2f__4) RHO0
PARAMETER ( RHO0 = 1028.000)
C
C **** statements ****
C
END MODULE
MODULE vars
use w2f__types
use active_module
use size
IMPLICIT NONE
C
C **** Global Variables ****
C
type(active) :: ETA(0 : 21, 0 : 21)
SAVE ETA
type(active) :: U(0 : 21, 0 : 21)
SAVE U
type(active) :: V(0 : 21, 0 : 21)
SAVE V
C
C **** statements ****
C
END MODULE
MODULE pfields
use w2f__types
use active_module
use size
IMPLICIT NONE
C
C **** Global Variables ****
C
type(active) :: DEPTH(0 : 21, 0 : 21)
SAVE DEPTH
type(active) :: DX(0 : 20)
SAVE DX
type(active) :: DY(0 : 20)
SAVE DY
type(active) :: ETAINI(1 : 20, 1 : 20)
SAVE ETAINI
type(active) :: ETAMASK(0 : 21, 0 : 21)
SAVE ETAMASK
type(active) :: FCORIU(1 : 20, 1 : 20)
SAVE FCORIU
type(active) :: FCORIV(1 : 20, 1 : 20)
SAVE FCORIV
type(active) :: FRICT(0 : 21, 0 : 21)
SAVE FRICT
type(active) :: HU(0 : 21, 0 : 21)
SAVE HU
type(active) :: HV(0 : 21, 0 : 21)
SAVE HV
type(active) :: HY(0 : 21)
SAVE HY
type(active) :: INIDEPTH(1 : 20, 1 : 20)
SAVE INIDEPTH
type(active) :: INVHU(0 : 21, 0 : 21)
SAVE INVHU
type(active) :: INVHV(0 : 21, 0 : 21)
SAVE INVHV
type(active) :: RX(0 : 21)
SAVE RX
type(active) :: RY
SAVE RY
type(active) :: SCALEDEPTH(1 : 20, 1 : 20)
SAVE SCALEDEPTH
type(active) :: SCALEETA(1 : 20, 1 : 20)
SAVE SCALEETA
type(active) :: SCALEU(1 : 20, 1 : 20)
SAVE SCALEU
type(active) :: SCALEV(1 : 20, 1 : 20)
SAVE SCALEV
type(active) :: UINI(1 : 20, 1 : 20)
SAVE UINI
type(active) :: UMASK(0 : 21, 0 : 21)
SAVE UMASK
type(active) :: VINI(1 : 20, 1 : 20)
SAVE VINI
type(active) :: VMASK(0 : 21, 0 : 21)
SAVE VMASK
type(active) :: X(0 : 21)
SAVE X
type(active) :: Y(0 : 21)
SAVE Y
C
C **** statements ****
C
END MODULE
MODULE force
use w2f__types
use active_module
use size
IMPLICIT NONE
C
C **** Global Variables ****
C
type(active) :: UFORCE(1 : 20, 1 : 20)
SAVE UFORCE
type(active) :: VFORCE(1 : 20, 1 : 20)
SAVE VFORCE
C
C **** statements ****
C
END MODULE
MODULE data
use w2f__types
use active_module
use size
IMPLICIT NONE
C
C **** Global Variables ****
C
type(active) :: DEPTH_DATA(1 : 20, 1 : 20)
SAVE DEPTH_DATA
type(active) :: ETA_DATA(1 : 20, 1 : 20)
SAVE ETA_DATA
type(active) :: ETA_DATA_TIME(1 : 1000)
SAVE ETA_DATA_TIME
INTEGER(w2f__i4) NEDT
SAVE NEDT
type(active) :: U_DATA(1 : 20, 1 : 20)
SAVE U_DATA
type(active) :: V_DATA(1 : 20, 1 : 20)
SAVE V_DATA
type(active) :: ZONAL_TRANSPORT_DATA
SAVE ZONAL_TRANSPORT_DATA
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) NEDTMAX
PARAMETER ( NEDTMAX = 1000)
C
C **** statements ****
C
END MODULE
MODULE weights
use w2f__types
use active_module
use size
IMPLICIT NONE
C
C **** Global Variables ****
C
type(active) :: WEIGHT_DEPTH(1 : 20, 1 : 20, 1 : 20, 1 : 20)
SAVE WEIGHT_DEPTH
type(active) :: WEIGHT_ETA(1 : 20, 1 : 20)
SAVE WEIGHT_ETA
type(active) :: WEIGHT_GRADDEPTH(1 : 20, 1 : 20)
SAVE WEIGHT_GRADDEPTH
type(active) :: WEIGHT_LAPLDEPTH(1 : 20, 1 : 20)
SAVE WEIGHT_LAPLDEPTH
type(active) :: WEIGHT_U(1 : 20, 1 : 20)
SAVE WEIGHT_U
type(active) :: WEIGHT_V(1 : 20, 1 : 20)
SAVE WEIGHT_V
type(active) :: WEIGHT_ZONAL_TRANSPORT
SAVE WEIGHT_ZONAL_TRANSPORT
type(active) :: WF_DEPTH
SAVE WF_DEPTH
type(active) :: WF_ETA
SAVE WF_ETA
type(active) :: WF_GRADDEPTH
SAVE WF_GRADDEPTH
type(active) :: WF_LAPLDEPTH
SAVE WF_LAPLDEPTH
type(active) :: WF_U
SAVE WF_U
type(active) :: WF_V
SAVE WF_V
type(active) :: WF_ZONAL_TRANSPORT
SAVE WF_ZONAL_TRANSPORT
C
C **** statements ****
C
END MODULE
MODULE mini
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Global Variables ****
C
type(active) :: DF1
SAVE DF1
type(active) :: DXMIN
SAVE DXMIN
type(active) :: EPSG
SAVE EPSG
type(active) :: EPS_GRAD
SAVE EPS_GRAD
type(active) :: FACTR
SAVE FACTR
INTEGER(w2f__i4) IMPRES
SAVE IMPRES
INTEGER(w2f__i4) IPRINT
SAVE IPRINT
INTEGER(w2f__i4) MODE
SAVE MODE
INTEGER(w2f__i4) NITER
SAVE NITER
INTEGER(w2f__i4) NSIM
SAVE NSIM
type(active) :: PGTOL
SAVE PGTOL
C
C **** statements ****
C
END MODULE
MODULE size_small
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) NX
PARAMETER ( NX = 20)
INTEGER(w2f__i4) NY
PARAMETER ( NY = 8)
C
C **** statements ****
C
END MODULE
SUBROUTINE inifields()
use w2f__types
use active_module
use size
use parms
use vars
use pfields
use force
use data
use weights
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IX2
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) IY2
C
C **** statements ****
C
NT = 0
NTSPINUP = 0
DT%v = 0.0D00
START_TIME%v = 0.0D00
DT_DUMP%v = 0.0D00
CALL zero_deriv(DT)
CALL zero_deriv(START_TIME)
CALL zero_deriv(DT_DUMP)
ITERATION = -9999
RINI%v = 0.0D00
OM%v = 0.0D00
F0%v = 0.0D00
BETA%v = 0.0D00
XSTART%v = 0.0D00
YSTART%v = 0.0D00
CALL zero_deriv(RINI)
CALL zero_deriv(OM)
CALL zero_deriv(F0)
CALL zero_deriv(BETA)
CALL zero_deriv(XSTART)
CALL zero_deriv(YSTART)
XPERIODIC = .FALSE.
YPERIODIC = .FALSE.
SPHERICAL = .FALSE.
CARTESIAN = .FALSE.
QUADFRIC = .FALSE.
SUPPRESSIO = .FALSE.
FULLIO = .FALSE.
INITIAL_GRAD = .FALSE.
GRAD_CHECK = .FALSE.
OPTIMIZE = .FALSE.
CALC_HESS = .FALSE.
FOUTNAME = ' '
RUNNAME = ' '
DEPTHFILE = ' '
FORCINGFILE = ' '
UINIFILE = ' '
VINIFILE = ' '
ETAINIFILE = ' '
NCDATAFILE = ' '
WF_DEPTH%v = 0.0D00
WF_ETA%v = 0.0D00
WF_U%v = 0.0D00
WF_V%v = 0.0D00
WF_ZONAL_TRANSPORT%v = 0.0D00
WF_LAPLDEPTH%v = 0.0D00
WF_GRADDEPTH%v = 0.0D00
CALL zero_deriv(WF_DEPTH)
CALL zero_deriv(WF_ETA)
CALL zero_deriv(WF_U)
CALL zero_deriv(WF_V)
CALL zero_deriv(WF_ZONAL_TRANSPORT)
CALL zero_deriv(WF_LAPLDEPTH)
CALL zero_deriv(WF_GRADDEPTH)
DO IX = 0, 21, 1
X(INT(IX))%v = 0.0D00
CALL zero_deriv(X(INT(IX)))
END DO
DO IY = 0, 21, 1
Y(INT(IY))%v = 0.0D00
CALL zero_deriv(Y(INT(IY)))
END DO
DO IX = 0, 20, 1
DX(INT(IX))%v = 0.0D00
CALL zero_deriv(DX(INT(IX)))
END DO
DO IY = 0, 20, 1
DY(INT(IY))%v = 0.0D00
CALL zero_deriv(DY(INT(IY)))
END DO
DO IY = 0, 21, 1
RX(INT(IY))%v = 0.0D00
CALL zero_deriv(RX(INT(IY)))
END DO
RY%v = 0.0D00
CALL zero_deriv(RY)
DO IY = 0, 21, 1
HY(INT(IY))%v = 0.0D00
CALL zero_deriv(HY(INT(IY)))
END DO
DT%v = 0.0D00
CALL zero_deriv(DT)
DO IY = 1, 20, 1
DO IX = 1, 20, 1
UFORCE(INT(IX),INT(IY))%v = 0.0D00
VFORCE(INT(IX),INT(IY))%v = 0.0D00
FCORIU(INT(IX),INT(IY))%v = 0.0D00
FCORIV(INT(IX),INT(IY))%v = 0.0D00
INIDEPTH(INT(IX),INT(IY))%v = 0.0D00
UINI(INT(IX),INT(IY))%v = 0.0D00
VINI(INT(IX),INT(IY))%v = 0.0D00
ETAINI(INT(IX),INT(IY))%v = 0.0D00
SCALEDEPTH(INT(IX),INT(IY))%v = 0.0D00
U_DATA(INT(IX),INT(IY))%v = 0.0D00
V_DATA(INT(IX),INT(IY))%v = 0.0D00
ETA_DATA(INT(IX),INT(IY))%v = 0.0D00
DEPTH_DATA(INT(IX),INT(IY))%v = 0.0D00
WEIGHT_U(INT(IX),INT(IY))%v = 0.0D00
WEIGHT_V(INT(IX),INT(IY))%v = 0.0D00
WEIGHT_ETA(INT(IX),INT(IY))%v = 0.0D00
WEIGHT_LAPLDEPTH(INT(IX),INT(IY))%v = 0.0D00
WEIGHT_GRADDEPTH(INT(IX),INT(IY))%v = 0.0D00
CALL zero_deriv(UFORCE(INT(IX),INT(IY)))
CALL zero_deriv(VFORCE(INT(IX),INT(IY)))
CALL zero_deriv(FCORIU(INT(IX),INT(IY)))
CALL zero_deriv(FCORIV(INT(IX),INT(IY)))
CALL zero_deriv(INIDEPTH(INT(IX),INT(IY)))
CALL zero_deriv(UINI(INT(IX),INT(IY)))
CALL zero_deriv(VINI(INT(IX),INT(IY)))
CALL zero_deriv(ETAINI(INT(IX),INT(IY)))
CALL zero_deriv(SCALEDEPTH(INT(IX),INT(IY)))
CALL zero_deriv(U_DATA(INT(IX),INT(IY)))
CALL zero_deriv(V_DATA(INT(IX),INT(IY)))
CALL zero_deriv(ETA_DATA(INT(IX),INT(IY)))
CALL zero_deriv(DEPTH_DATA(INT(IX),INT(IY)))
CALL zero_deriv(WEIGHT_U(INT(IX),INT(IY)))
CALL zero_deriv(WEIGHT_V(INT(IX),INT(IY)))
CALL zero_deriv(WEIGHT_ETA(INT(IX),INT(IY)))
CALL zero_deriv(WEIGHT_LAPLDEPTH(INT(IX),INT(IY)))
CALL zero_deriv(WEIGHT_GRADDEPTH(INT(IX),INT(IY)))
END DO
END DO
DO IY = 1, 20, 1
DO IY2 = 1, 20, 1
DO IX = 1, 20, 1
DO IX2 = 1, 20, 1
WEIGHT_DEPTH(INT(IX),INT(IX2),INT(IY),INT(IY2))%v = 0.0D00
CALL zero_deriv(WEIGHT_DEPTH(INT(IX),INT(IX2),INT(IY),INT(
+IY2)))
END DO
END DO
END DO
END DO
ZONAL_TRANSPORT_DATA%v = 0.0D00
WEIGHT_ZONAL_TRANSPORT%v = 0.0D00
CALL zero_deriv(ZONAL_TRANSPORT_DATA)
CALL zero_deriv(WEIGHT_ZONAL_TRANSPORT)
DO IX = 0, 21, 1
DO IY = 0, 21, 1
DEPTH(INT(IX),INT(IY))%v = 0.0D00
FRICT(INT(IX),INT(IY))%v = 0.0D00
U(INT(IX),INT(IY))%v = 0.0D00
V(INT(IX),INT(IY))%v = 0.0D00
ETA(INT(IX),INT(IY))%v = 0.0D00
UMASK(INT(IX),INT(IY))%v = 0.0D00
VMASK(INT(IX),INT(IY))%v = 0.0D00
ETAMASK(INT(IX),INT(IY))%v = 0.0D00
HU(INT(IX),INT(IY))%v = 0.0D00
HV(INT(IX),INT(IY))%v = 0.0D00
INVHU(INT(IX),INT(IY))%v = 0.0D00
INVHV(INT(IX),INT(IY))%v = 0.0D00
CALL zero_deriv(DEPTH(INT(IX),INT(IY)))
CALL zero_deriv(FRICT(INT(IX),INT(IY)))
CALL zero_deriv(U(INT(IX),INT(IY)))
CALL zero_deriv(V(INT(IX),INT(IY)))
CALL zero_deriv(ETA(INT(IX),INT(IY)))
CALL zero_deriv(UMASK(INT(IX),INT(IY)))
CALL zero_deriv(VMASK(INT(IX),INT(IY)))
CALL zero_deriv(ETAMASK(INT(IX),INT(IY)))
CALL zero_deriv(HU(INT(IX),INT(IY)))
CALL zero_deriv(HV(INT(IX),INT(IY)))
CALL zero_deriv(INVHU(INT(IX),INT(IY)))
CALL zero_deriv(INVHV(INT(IX),INT(IY)))
END DO
END DO
RETURN
END SUBROUTINE
SUBROUTINE readparms()
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
EXTERNAL check_cfl
EXTERNAL ini_scales
EXTERNAL make_masks
EXTERNAL prep_coriolis
EXTERNAL prep_depth
EXTERNAL read_data_fields
EXTERNAL read_data_file
C
C **** statements ****
C
CALL read_data_file()
CALL read_data_fields()
CALL prep_depth()
CALL check_cfl()
CALL make_masks()
CALL ini_scales()
CALL prep_coriolis()
RETURN
END SUBROUTINE
SUBROUTINE read_data_file()
use w2f__types
use active_module
use size
use parms
use pfields
use mini
use weights
IMPLICIT NONE
C
C **** Global Variables ****
C
REAL(w2f__8) OpenAD_Symbol_0
REAL(w2f__8) OpenAD_Symbol_1
REAL(w2f__8) OpenAD_Symbol_2
REAL(w2f__8) OpenAD_Symbol_3
REAL(w2f__8) OpenAD_Symbol_5
REAL(w2f__8) OpenAD_Symbol_6
REAL(w2f__8) OpenAD_Symbol_7
REAL(w2f__8) OpenAD_Symbol_9
REAL(w2f__8) OpenAD_Symbol_11
REAL(w2f__8) OpenAD_Symbol_12
REAL(w2f__8) OpenAD_Symbol_13
REAL(w2f__8) OpenAD_Symbol_14
REAL(w2f__8) OpenAD_Symbol_15
REAL(w2f__8) OpenAD_Symbol_21
REAL(w2f__8) OpenAD_Symbol_17
REAL(w2f__8) OpenAD_Symbol_18
REAL(w2f__8) OpenAD_Symbol_23
REAL(w2f__8) OpenAD_Symbol_19
REAL(w2f__8) OpenAD_Symbol_24
REAL(w2f__8) OpenAD_Symbol_25
REAL(w2f__8) OpenAD_Symbol_26
REAL(w2f__8) OpenAD_Symbol_31
REAL(w2f__8) OpenAD_Symbol_27
REAL(w2f__8) OpenAD_Symbol_32
REAL(w2f__8) OpenAD_Symbol_28
REAL(w2f__8) OpenAD_Symbol_29
REAL(w2f__8) OpenAD_Symbol_34
REAL(w2f__8) OpenAD_Symbol_35
REAL(w2f__8) OpenAD_Symbol_40
REAL(w2f__8) OpenAD_Symbol_36
REAL(w2f__8) OpenAD_Symbol_37
REAL(w2f__8) OpenAD_Symbol_42
REAL(w2f__8) OpenAD_Symbol_43
REAL(w2f__8) OpenAD_Symbol_39
REAL(w2f__8) OpenAD_Symbol_44
REAL(w2f__8) OpenAD_Symbol_45
REAL(w2f__8) OpenAD_Symbol_50
REAL(w2f__8) OpenAD_Symbol_46
REAL(w2f__8) OpenAD_Symbol_52
REAL(w2f__8) OpenAD_Symbol_48
REAL(w2f__8) OpenAD_Symbol_53
REAL(w2f__8) OpenAD_Symbol_49
REAL(w2f__8) OpenAD_Symbol_54
REAL(w2f__8) OpenAD_Symbol_56
REAL(w2f__8) OpenAD_Symbol_720
type(active) :: OpenAD_Symbol_721
REAL(w2f__8) OpenAD_Symbol_722
REAL(w2f__8) OpenAD_Symbol_718
type(active) :: OpenAD_Symbol_723
REAL(w2f__8) OpenAD_Symbol_719
REAL(w2f__8) OpenAD_Symbol_724
REAL(w2f__8) OpenAD_Symbol_725
REAL(w2f__8) OpenAD_Symbol_730
REAL(w2f__8) OpenAD_Symbol_726
type(active) :: OpenAD_Symbol_731
type(active) :: OpenAD_Symbol_727
REAL(w2f__8) OpenAD_Symbol_732
REAL(w2f__8) OpenAD_Symbol_728
type(active) :: OpenAD_Symbol_733
type(active) :: OpenAD_Symbol_729
REAL(w2f__8) OpenAD_Symbol_734
type(active) :: OpenAD_Symbol_735
REAL(w2f__8) OpenAD_Symbol_740
REAL(w2f__8) OpenAD_Symbol_736
REAL(w2f__8) OpenAD_Symbol_741
type(active) :: OpenAD_Symbol_737
REAL(w2f__8) OpenAD_Symbol_742
REAL(w2f__8) OpenAD_Symbol_738
type(active) :: OpenAD_Symbol_743
REAL(w2f__8) OpenAD_Symbol_739
REAL(w2f__8) OpenAD_Symbol_744
type(active) :: OpenAD_Symbol_745
REAL(w2f__8) OpenAD_Symbol_750
REAL(w2f__8) OpenAD_Symbol_746
type(active) :: OpenAD_Symbol_751
type(active) :: OpenAD_Symbol_747
REAL(w2f__8) OpenAD_Symbol_748
type(active) :: OpenAD_Symbol_749
C
C **** Local Variables and functions ****
C
type(active) :: DELX
type(active) :: DELY
EXTERNAL determine_data_time
INTEGER(w2f__i4) IADRH0
INTEGER(w2f__i4) IADRH1
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
EXTERNAL readhack
CHARACTER(4) t__15
C
C **** statements ****
C
C open(20,file='data',form='formatted',status='old')
t__15 = 'OLD '
OPEN(UNIT = 20, FORM = 'FORMATTED', STATUS = t__15(1_w2f__i8 : 3)
> , FILE = 'data')
READ(20, *)
read(20,*) nt,ntspinup,dt%v,start_time%v,dt_dump%v
READ(20, *)
read(20,*) rini%v,f0%v,beta%v
READ(20, *)
read(20,*) xstart%v,ystart%v
READ(20, *)
read(20,*) delx%v,dely%v
READ(20, *)
read(20,*)xperiodic,yperiodic,spherical,cartesian
READ(20, *)
read(20,*)fullio,suppressio
READ(20, *)
read(20,*)initial_grad,grad_check,optimize,calc_hess
READ(20, *)
read(20,'(A80)')ncdatafile
READ(20, *)
read(20,'(A80)')ncrestartfile
READ(20, *)
read(20,'(A80)')foutname
READ(20, *)
read(20,'(A80)')runname
READ(20, *)
read(20,*) wf_depth%v,wf_eta%v,wf_u%v,wf_v%v,wf_zonal_transport%v,
+wf_lapldepth%v,wf_graddepth%v
READ(20, *)
read(20,*)nsim
READ(20, *)
read(20,*) epsg%v,df1%v,dxmin%v,niter,impres,mode
READ(20, *)
read(20,*) eps_grad%v,pgtol%v,factr%v,iprint
C close(20)
CLOSE(UNIT = 20)
IF(CARTESIAN .AND. SPHERICAL) THEN
WRITE(*, *) 'grid specification is ambiguous'
ELSE
IF(.NOT.(CARTESIAN .OR. SPHERICAL)) THEN
WRITE(*, *) 'grid specification is ambiguous'
ENDIF
ENDIF
IF(SPHERICAL .AND. YPERIODIC) THEN
WRITE(*, *) 'spherical grid and periodic boundary conditions'
WRITE(*, *) 'in latitude do not make sense'
ENDIF
IF (YPERIODIC .AND. (SPHERICAL .OR. (CARTESIAN .AND. (BETA%v .ne.
+0.0D00)))) THEN
WRITE(*, *) 'yperiodic boundaries only make sense on an f-pla'
> // 'ne'
ENDIF
IF(SPHERICAL) THEN
DO IY = 0, 21, 1
OpenAD_Symbol_5 = (DELY%v/6.371D+06)
OpenAD_Symbol_6 = (REAL(IY) +(-5.0D-01))
OpenAD_Symbol_2 = (OpenAD_Symbol_5 * OpenAD_Symbol_6)
OpenAD_Symbol_11 = (YSTART%v+(OpenAD_Symbol_2/1.74533000000000
+014518D-02))
OpenAD_Symbol_0 = 1_w2f__i8
OpenAD_Symbol_9 = (INT(1_w2f__i8) / 6.371D+06)
OpenAD_Symbol_7 = OpenAD_Symbol_6
OpenAD_Symbol_3 = (INT(1_w2f__i8) /
> 1.74533000000000014518D-02)
OpenAD_Symbol_1 = 1_w2f__i8
Y(INT(IY))%v = OpenAD_Symbol_11
OpenAD_Symbol_718 = (OpenAD_Symbol_9 * OpenAD_Symbol_7)
OpenAD_Symbol_719 = (OpenAD_Symbol_718 * OpenAD_Symbol_3)
OpenAD_Symbol_720 = (OpenAD_Symbol_719 * OpenAD_Symbol_1)
OpenAD_Symbol_722 = OpenAD_Symbol_0
CALL setderiv(OpenAD_Symbol_723,YSTART)
CALL setderiv(OpenAD_Symbol_721,DELY)
CALL sax(OpenAD_Symbol_720,OpenAD_Symbol_721,Y(IY))
CALL saxpy(OpenAD_Symbol_722,OpenAD_Symbol_723,Y(IY))
END DO
DO IX = 0, 21, 1
OpenAD_Symbol_17 = (DELX%v/6.371D+06)
OpenAD_Symbol_18 = (REAL(IX) +(-5.0D-01))
OpenAD_Symbol_14 = (OpenAD_Symbol_17 * OpenAD_Symbol_18)
OpenAD_Symbol_23 = (XSTART%v+(OpenAD_Symbol_14/1.7453300000000
+0014518D-02))
OpenAD_Symbol_12 = 1_w2f__i8
OpenAD_Symbol_21 = (INT(1_w2f__i8) / 6.371D+06)
OpenAD_Symbol_19 = OpenAD_Symbol_18
OpenAD_Symbol_15 = (INT(1_w2f__i8) /
> 1.74533000000000014518D-02)
OpenAD_Symbol_13 = 1_w2f__i8
X(INT(IX))%v = OpenAD_Symbol_23
OpenAD_Symbol_724 = (OpenAD_Symbol_21 * OpenAD_Symbol_19)
OpenAD_Symbol_725 = (OpenAD_Symbol_724 * OpenAD_Symbol_15)
OpenAD_Symbol_726 = (OpenAD_Symbol_725 * OpenAD_Symbol_13)
OpenAD_Symbol_728 = OpenAD_Symbol_12
CALL setderiv(OpenAD_Symbol_729,XSTART)
CALL setderiv(OpenAD_Symbol_727,DELX)
CALL sax(OpenAD_Symbol_726,OpenAD_Symbol_727,X(IX))
CALL saxpy(OpenAD_Symbol_728,OpenAD_Symbol_729,X(IX))
END DO
ELSE
IF(CARTESIAN) THEN
DO IX = 0, 21, 1
OpenAD_Symbol_49 = (REAL(IX) +(-5.0D-01))
OpenAD_Symbol_52 = (DELX%v*OpenAD_Symbol_49)
OpenAD_Symbol_50 = OpenAD_Symbol_49
X(INT(IX))%v = OpenAD_Symbol_52
OpenAD_Symbol_748 = OpenAD_Symbol_50
CALL setderiv(OpenAD_Symbol_749,DELX)
CALL sax(OpenAD_Symbol_748,OpenAD_Symbol_749,X(IX))
END DO
DO IY = 0, 21, 1
OpenAD_Symbol_53 = (REAL(IY) +(-5.0D-01))
OpenAD_Symbol_56 = (DELY%v*OpenAD_Symbol_53)
OpenAD_Symbol_54 = OpenAD_Symbol_53
Y(INT(IY))%v = OpenAD_Symbol_56
OpenAD_Symbol_750 = OpenAD_Symbol_54
CALL setderiv(OpenAD_Symbol_751,DELY)
CALL sax(OpenAD_Symbol_750,OpenAD_Symbol_751,Y(IY))
END DO
ENDIF
ENDIF
DO IX = 0, 20, 1
DX(INT(IX))%v = (X(IX+1)%v-X(IX)%v)
OpenAD_Symbol_24 = 1_w2f__i8
OpenAD_Symbol_25 = (-1_w2f__i8)
OpenAD_Symbol_730 = OpenAD_Symbol_24
OpenAD_Symbol_732 = OpenAD_Symbol_25
CALL setderiv(OpenAD_Symbol_733,X(IX))
CALL setderiv(OpenAD_Symbol_731,X(IX+1))
CALL sax(OpenAD_Symbol_730,OpenAD_Symbol_731,DX(IX))
CALL saxpy(OpenAD_Symbol_732,OpenAD_Symbol_733,DX(IX))
END DO
DO IY = 0, 20, 1
DY(INT(IY))%v = (Y(IY+1)%v-Y(IY)%v)
OpenAD_Symbol_26 = 1_w2f__i8
OpenAD_Symbol_27 = (-1_w2f__i8)
OpenAD_Symbol_734 = OpenAD_Symbol_26
OpenAD_Symbol_736 = OpenAD_Symbol_27
CALL setderiv(OpenAD_Symbol_737,Y(IY))
CALL setderiv(OpenAD_Symbol_735,Y(IY+1))
CALL sax(OpenAD_Symbol_734,OpenAD_Symbol_735,DY(IY))
CALL saxpy(OpenAD_Symbol_736,OpenAD_Symbol_737,DY(IY))
END DO
DO IY = 1, 20, 1
IF(SPHERICAL) THEN
OpenAD_Symbol_39 = (Y(IY)%v+Y(IY+1)%v)
OpenAD_Symbol_36 = (OpenAD_Symbol_39 * 5.0D-01)
OpenAD_Symbol_34 = (OpenAD_Symbol_36 *
> 1.74533000000000014518D-02)
OpenAD_Symbol_31 = COS(OpenAD_Symbol_34)
OpenAD_Symbol_28 = (OpenAD_Symbol_31 * 6.371D+06)
RX(INT(IY))%v = (OpenAD_Symbol_28*1.74533000000000014518D-02)
OpenAD_Symbol_42 = 1_w2f__i8
OpenAD_Symbol_43 = 1_w2f__i8
OpenAD_Symbol_40 = 5.0D-01
OpenAD_Symbol_37 = 1.74533000000000014518D-02
OpenAD_Symbol_35 = (- SIN(OpenAD_Symbol_34))
OpenAD_Symbol_32 = 6.371D+06
OpenAD_Symbol_29 = 1.74533000000000014518D-02
OpenAD_Symbol_738 = (OpenAD_Symbol_32 * OpenAD_Symbol_29)
OpenAD_Symbol_739 = (OpenAD_Symbol_35 * OpenAD_Symbol_738)
OpenAD_Symbol_740 = (OpenAD_Symbol_37 * OpenAD_Symbol_739)
OpenAD_Symbol_741 = (OpenAD_Symbol_40 * OpenAD_Symbol_740)
OpenAD_Symbol_742 = (OpenAD_Symbol_42 * OpenAD_Symbol_741)
OpenAD_Symbol_744 = (OpenAD_Symbol_43 * OpenAD_Symbol_741)
CALL setderiv(OpenAD_Symbol_745,Y(IY+1))
CALL setderiv(OpenAD_Symbol_743,Y(IY))
CALL sax(OpenAD_Symbol_742,OpenAD_Symbol_743,RX(IY))
CALL saxpy(OpenAD_Symbol_744,OpenAD_Symbol_745,RX(IY))
ELSE
IF(CARTESIAN) THEN
RX(INT(IY))%v = 1.0D00
CALL zero_deriv(RX(INT(IY)))
ENDIF
ENDIF
END DO
IF(SPHERICAL) THEN
RY%v = 1.11195D+05
CALL zero_deriv(RY)
ELSE
IF(CARTESIAN) THEN
RY%v = 1.0D00
CALL zero_deriv(RY)
ENDIF
ENDIF
DO IY = 1, 21, 1
IF(SPHERICAL) THEN
OpenAD_Symbol_44 = (Y(IY)%v*1.74533000000000014518D-02)
OpenAD_Symbol_48 = COS(OpenAD_Symbol_44)
OpenAD_Symbol_46 = 1.74533000000000014518D-02
OpenAD_Symbol_45 = (- SIN(OpenAD_Symbol_44))
HY(INT(IY))%v = OpenAD_Symbol_48
OpenAD_Symbol_746 = (OpenAD_Symbol_46 * OpenAD_Symbol_45)
CALL setderiv(OpenAD_Symbol_747,Y(IY))
CALL sax(OpenAD_Symbol_746,OpenAD_Symbol_747,HY(IY))
ELSE
IF(CARTESIAN) THEN
HY(INT(IY))%v = 1.0D00
CALL zero_deriv(HY(INT(IY)))
ENDIF
ENDIF
END DO
CALL determine_data_time(NCDATAFILE)
RETURN
END SUBROUTINE
SUBROUTINE read_data_fields()
use w2f__types
use active_module
use size
use parms
use pfields
use force
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
EXTERNAL boundary_conditions
LOGICAL(w2f__i4) EXISTS
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
type(active) :: MYTIME
EXTERNAL read_extended_field
EXTERNAL read_field
CHARACTER(80) STR1
CHARACTER(80) STR2
CHARACTER(80) STR3
type(active) :: X_IN(1 : 20)
type(active) :: Y_IN(1 : 20)
C
C **** statements ****
C
MYNX = 20
MYNY = 20
MYTIME%v = (-1.0D00)
CALL zero_deriv(MYTIME)
DO IX = 1, 20, 1
X_IN(INT(IX))%v = 0.0D00
CALL zero_deriv(X_IN(INT(IX)))
END DO
DO IY = 1, 20, 1
Y_IN(INT(IY))%v = 0.0D00
CALL zero_deriv(Y_IN(INT(IY)))
END DO
C inquire(file=ncdatafile,exist=exists)
INQUIRE(EXIST = EXISTS, FILE = NCDATAFILE)
IF(.NOT. EXISTS) THEN
WRITE(*, *) NCDATAFILE, ' not found, cannot continue'
ELSE
STR1 = 'depth'
STR2 = 'frict'
CALL read_field(NCDATAFILE,MYTIME,STR1,INIDEPTH)
CALL read_extended_field(NCDATAFILE,STR2,FRICT)
IF (RINI%v .ne. 0.0D00) THEN
WRITE(*,*)'rini = ',RINI%v
WRITE(*, *) 'will overwrite frict with rini'
DO IX = 1, 20, 1
DO IY = 1, 20, 1
FRICT(INT(IX),INT(IY))%v = RINI%v
CALL setderiv(FRICT(IX,IY),RINI)
END DO
END DO
ENDIF
CALL boundary_conditions(MYNX,MYNY,FRICT,XPERIODIC,YPERIODIC)
STR1 = 'uforce'
STR2 = 'vforce'
CALL read_field(NCDATAFILE,MYTIME,STR1,UFORCE)
CALL read_field(NCDATAFILE,MYTIME,STR2,VFORCE)
IF (START_TIME%v .eq. 0.0D00) THEN
WRITE(*, *) 'cold start from initial fields'
STR1 = 'uini'
STR2 = 'vini'
STR3 = 'etaini'
CALL read_field(NCDATAFILE,START_TIME,STR1,UINI)
CALL read_field(NCDATAFILE,START_TIME,STR2,VINI)
CALL read_field(NCDATAFILE,START_TIME,STR3,ETAINI)
ELSE
WRITE(*,*)'warm restart from time ',START_TIME%v
WRITE(*, *) 'in restart file ', NCRESTARTFILE
C inquire( file = ncrestartfile, exist = exists )
INQUIRE(EXIST = EXISTS, FILE = NCRESTARTFILE)
IF(.NOT. EXISTS) THEN
WRITE(*, *) NCRESTARTFILE, ' not found'
ELSE
STR1 = 'U'
STR2 = 'V'
STR3 = 'ETA'
CALL read_field(NCRESTARTFILE,START_TIME,STR1,UINI)
CALL read_field(NCRESTARTFILE,START_TIME,STR2,VINI)
CALL read_field(NCRESTARTFILE,START_TIME,STR3,ETAINI)
ENDIF
ENDIF
ENDIF
RETURN
END SUBROUTINE
SUBROUTINE prep_depth()
use w2f__types
use active_module
use size
use parms
use pfields
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
EXTERNAL boundary_conditions
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
type(active) :: MAXDEPTH
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
EXTERNAL read_depth_data
C
C **** statements ****
C
MYNX = 20
MYNY = 20
MAXDEPTH%v = 0.0D00
CALL zero_deriv(MAXDEPTH)
DO IY = 1, 20, 1
DO IX = 1, 20, 1
IF (INIDEPTH(IX,IY)%v .GT. MAXDEPTH%v) THEN
MAXDEPTH%v = INIDEPTH(IX,IY)%v
CALL setderiv(MAXDEPTH,INIDEPTH(IX,IY))
ENDIF
END DO
END DO
DO IX = 1, 20, 1
DO IY = 1, 20, 1
DEPTH(INT(IX),INT(IY))%v = INIDEPTH(IX,IY)%v
CALL setderiv(DEPTH(IX,IY),INIDEPTH(IX,IY))
SCALEDEPTH(INT(IX),INT(IY))%v = INIDEPTH(IX,IY)%v
CALL setderiv(SCALEDEPTH(IX,IY),INIDEPTH(IX,IY))
IF (DEPTH(IX,IY)%v .LT. MAXDEPTH%v) THEN
ENDIF
END DO
END DO
CALL read_depth_data()
CALL boundary_conditions(MYNX,MYNY,DEPTH,XPERIODIC,YPERIODIC)
RETURN
END SUBROUTINE
SUBROUTINE ini_scales()
use w2f__types
use active_module
use size
use pfields
IMPLICIT NONE
C
C **** Global Variables ****
C
REAL(w2f__8) OpenAD_Symbol_73
REAL(w2f__8) OpenAD_Symbol_74
REAL(w2f__8) OpenAD_Symbol_75
REAL(w2f__8) OpenAD_Symbol_80
REAL(w2f__8) OpenAD_Symbol_76
REAL(w2f__8) OpenAD_Symbol_81
REAL(w2f__8) OpenAD_Symbol_77
REAL(w2f__8) OpenAD_Symbol_82
REAL(w2f__8) OpenAD_Symbol_78
REAL(w2f__8) OpenAD_Symbol_83
REAL(w2f__8) OpenAD_Symbol_79
REAL(w2f__8) OpenAD_Symbol_84
REAL(w2f__8) OpenAD_Symbol_85
REAL(w2f__8) OpenAD_Symbol_86
REAL(w2f__8) OpenAD_Symbol_87
REAL(w2f__8) OpenAD_Symbol_765
type(active) :: OpenAD_Symbol_770
type(active) :: OpenAD_Symbol_766
REAL(w2f__8) OpenAD_Symbol_771
REAL(w2f__8) OpenAD_Symbol_767
type(active) :: OpenAD_Symbol_772
type(active) :: OpenAD_Symbol_768
REAL(w2f__8) OpenAD_Symbol_773
REAL(w2f__8) OpenAD_Symbol_769
type(active) :: OpenAD_Symbol_774
REAL(w2f__8) OpenAD_Symbol_775
type(active) :: OpenAD_Symbol_776
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
type(active) :: VARETA
EXTERNAL variance
type(active) :: VARU
type(active) :: VARV
C
C **** statements ****
C
MYNX = 20
MYNY = 20
CALL variance(MYNX,MYNY,UINI,UMASK,VARU)
IF (VARU%v .eq. 0.0D00) THEN
VARU%v = 1.0D00
CALL zero_deriv(VARU)
ENDIF
CALL variance(MYNX,MYNY,VINI,VMASK,VARV)
IF (VARU%v .eq. 0.0D00) THEN
VARV%v = 1.0D00
CALL zero_deriv(VARV)
ENDIF
CALL variance(MYNX,MYNY,ETAINI,ETAMASK,VARETA)
IF (VARU%v .eq. 0.0D00) THEN
VARETA%v = 1.0D00
CALL zero_deriv(VARETA)
ENDIF
DO IY = 1, 20, 1
DO IX = 1, 20, 1
OpenAD_Symbol_73 = SQRT(VARU%v)
OpenAD_Symbol_77 = (UMASK(IX,IY)%v*OpenAD_Symbol_73)
OpenAD_Symbol_74 = OpenAD_Symbol_73
OpenAD_Symbol_76 = (5.0D-01 / OpenAD_Symbol_73)
OpenAD_Symbol_75 = UMASK(IX,IY)%v
SCALEU(INT(IX),INT(IY))%v = OpenAD_Symbol_77
OpenAD_Symbol_765 = (OpenAD_Symbol_76 * OpenAD_Symbol_75)
OpenAD_Symbol_767 = OpenAD_Symbol_74
CALL setderiv(OpenAD_Symbol_768,UMASK(IX,IY))
CALL setderiv(OpenAD_Symbol_766,VARU)
CALL sax(OpenAD_Symbol_765,OpenAD_Symbol_766,SCALEU(IX,IY))
CALL saxpy(OpenAD_Symbol_767,OpenAD_Symbol_768,SCALEU(IX,IY))
OpenAD_Symbol_78 = SQRT(VARV%v)
OpenAD_Symbol_82 = (VMASK(IX,IY)%v*OpenAD_Symbol_78)
OpenAD_Symbol_79 = OpenAD_Symbol_78
OpenAD_Symbol_81 = (5.0D-01 / OpenAD_Symbol_78)
OpenAD_Symbol_80 = VMASK(IX,IY)%v
SCALEV(INT(IX),INT(IY))%v = OpenAD_Symbol_82
OpenAD_Symbol_769 = (OpenAD_Symbol_81 * OpenAD_Symbol_80)
OpenAD_Symbol_771 = OpenAD_Symbol_79
CALL setderiv(OpenAD_Symbol_772,VMASK(IX,IY))
CALL setderiv(OpenAD_Symbol_770,VARV)
CALL sax(OpenAD_Symbol_769,OpenAD_Symbol_770,SCALEV(IX,IY))
CALL saxpy(OpenAD_Symbol_771,OpenAD_Symbol_772,SCALEV(IX,IY))
OpenAD_Symbol_83 = SQRT(VARETA%v)
OpenAD_Symbol_87 = (ETAMASK(IX,IY)%v*OpenAD_Symbol_83)
OpenAD_Symbol_84 = OpenAD_Symbol_83
OpenAD_Symbol_86 = (5.0D-01 / OpenAD_Symbol_83)
OpenAD_Symbol_85 = ETAMASK(IX,IY)%v
SCALEETA(INT(IX),INT(IY))%v = OpenAD_Symbol_87
OpenAD_Symbol_773 = (OpenAD_Symbol_86 * OpenAD_Symbol_85)
OpenAD_Symbol_775 = OpenAD_Symbol_84
CALL setderiv(OpenAD_Symbol_776,ETAMASK(IX,IY))
CALL setderiv(OpenAD_Symbol_774,VARETA)
CALL sax(OpenAD_Symbol_773,OpenAD_Symbol_774,SCALEETA(IX,IY))
CALL saxpy(OpenAD_Symbol_775,OpenAD_Symbol_776,SCALEETA(IX,IY)
+)
END DO
END DO
RETURN
END SUBROUTINE
SUBROUTINE prep_coriolis()
use w2f__types
use active_module
use size
use parms
use pfields
IMPLICIT NONE
C
C **** Global Variables ****
C
REAL(w2f__8) OpenAD_Symbol_90
REAL(w2f__8) OpenAD_Symbol_91
REAL(w2f__8) OpenAD_Symbol_92
REAL(w2f__8) OpenAD_Symbol_88
REAL(w2f__8) OpenAD_Symbol_93
REAL(w2f__8) OpenAD_Symbol_89
REAL(w2f__8) OpenAD_Symbol_94
REAL(w2f__8) OpenAD_Symbol_96
REAL(w2f__8) OpenAD_Symbol_98
REAL(w2f__8) OpenAD_Symbol_99
REAL(w2f__8) OpenAD_Symbol_100
REAL(w2f__8) OpenAD_Symbol_101
REAL(w2f__8) OpenAD_Symbol_102
REAL(w2f__8) OpenAD_Symbol_103
REAL(w2f__8) OpenAD_Symbol_104
REAL(w2f__8) OpenAD_Symbol_105
REAL(w2f__8) OpenAD_Symbol_110
REAL(w2f__8) OpenAD_Symbol_106
REAL(w2f__8) OpenAD_Symbol_111
REAL(w2f__8) OpenAD_Symbol_107
REAL(w2f__8) OpenAD_Symbol_112
REAL(w2f__8) OpenAD_Symbol_108
REAL(w2f__8) OpenAD_Symbol_113
REAL(w2f__8) OpenAD_Symbol_109
REAL(w2f__8) OpenAD_Symbol_114
REAL(w2f__8) OpenAD_Symbol_115
REAL(w2f__8) OpenAD_Symbol_120
REAL(w2f__8) OpenAD_Symbol_116
REAL(w2f__8) OpenAD_Symbol_121
REAL(w2f__8) OpenAD_Symbol_117
REAL(w2f__8) OpenAD_Symbol_122
REAL(w2f__8) OpenAD_Symbol_123
REAL(w2f__8) OpenAD_Symbol_119
REAL(w2f__8) OpenAD_Symbol_124
REAL(w2f__8) OpenAD_Symbol_125
REAL(w2f__8) OpenAD_Symbol_130
REAL(w2f__8) OpenAD_Symbol_126
REAL(w2f__8) OpenAD_Symbol_131
REAL(w2f__8) OpenAD_Symbol_127
REAL(w2f__8) OpenAD_Symbol_132
REAL(w2f__8) OpenAD_Symbol_128
REAL(w2f__8) OpenAD_Symbol_129
REAL(w2f__8) OpenAD_Symbol_134
REAL(w2f__8) OpenAD_Symbol_135
REAL(w2f__8) OpenAD_Symbol_140
REAL(w2f__8) OpenAD_Symbol_136
REAL(w2f__8) OpenAD_Symbol_137
REAL(w2f__8) OpenAD_Symbol_142
REAL(w2f__8) OpenAD_Symbol_139
REAL(w2f__8) OpenAD_Symbol_800
REAL(w2f__8) OpenAD_Symbol_801
type(active) :: OpenAD_Symbol_802
REAL(w2f__8) OpenAD_Symbol_803
type(active) :: OpenAD_Symbol_804
REAL(w2f__8) OpenAD_Symbol_805
REAL(w2f__8) OpenAD_Symbol_810
type(active) :: OpenAD_Symbol_806
type(active) :: OpenAD_Symbol_811
REAL(w2f__8) OpenAD_Symbol_807
REAL(w2f__8) OpenAD_Symbol_812
type(active) :: OpenAD_Symbol_808
type(active) :: OpenAD_Symbol_813
REAL(w2f__8) OpenAD_Symbol_809
REAL(w2f__8) OpenAD_Symbol_814
type(active) :: OpenAD_Symbol_815
type(active) :: OpenAD_Symbol_820
REAL(w2f__8) OpenAD_Symbol_816
REAL(w2f__8) OpenAD_Symbol_821
REAL(w2f__8) OpenAD_Symbol_817
type(active) :: OpenAD_Symbol_822
type(active) :: OpenAD_Symbol_818
REAL(w2f__8) OpenAD_Symbol_823
REAL(w2f__8) OpenAD_Symbol_819
type(active) :: OpenAD_Symbol_824
REAL(w2f__8) OpenAD_Symbol_780
REAL(w2f__8) OpenAD_Symbol_825
type(active) :: OpenAD_Symbol_781
type(active) :: OpenAD_Symbol_826
REAL(w2f__8) OpenAD_Symbol_777
REAL(w2f__8) OpenAD_Symbol_782
REAL(w2f__8) OpenAD_Symbol_778
type(active) :: OpenAD_Symbol_783
type(active) :: OpenAD_Symbol_779
REAL(w2f__8) OpenAD_Symbol_784
REAL(w2f__8) OpenAD_Symbol_785
type(active) :: OpenAD_Symbol_790
type(active) :: OpenAD_Symbol_786
REAL(w2f__8) OpenAD_Symbol_791
REAL(w2f__8) OpenAD_Symbol_787
type(active) :: OpenAD_Symbol_792
type(active) :: OpenAD_Symbol_788
REAL(w2f__8) OpenAD_Symbol_793
REAL(w2f__8) OpenAD_Symbol_789
REAL(w2f__8) OpenAD_Symbol_794
type(active) :: OpenAD_Symbol_795
REAL(w2f__8) OpenAD_Symbol_796
type(active) :: OpenAD_Symbol_797
REAL(w2f__8) OpenAD_Symbol_798
type(active) :: OpenAD_Symbol_799
C
C **** Local Variables and functions ****
C
type(active) :: FAUX
type(active) :: FCORI(0 : 21, 0 : 21)
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) MY
C
C **** statements ****
C
MY = NINT(REAL(20) * 5.0E-01)
DO IY = 0, 21, 1
IF(SPHERICAL) THEN
OpenAD_Symbol_92 = (Y(IY)%v*1.74533000000000014518D-02)
OpenAD_Symbol_88 = SIN(OpenAD_Symbol_92)
OpenAD_Symbol_89 = (OM%v*2.0D00)
OpenAD_Symbol_98 = (OpenAD_Symbol_88 * OpenAD_Symbol_89)
OpenAD_Symbol_94 = 1.74533000000000014518D-02
OpenAD_Symbol_93 = COS(OpenAD_Symbol_92)
OpenAD_Symbol_90 = OpenAD_Symbol_89
OpenAD_Symbol_96 = 2.0D00
OpenAD_Symbol_91 = OpenAD_Symbol_88
FAUX%v = OpenAD_Symbol_98
OpenAD_Symbol_777 = (OpenAD_Symbol_94 * OpenAD_Symbol_93)
OpenAD_Symbol_778 = (OpenAD_Symbol_96 * OpenAD_Symbol_91)
OpenAD_Symbol_780 = (OpenAD_Symbol_777 * OpenAD_Symbol_90)
CALL setderiv(OpenAD_Symbol_781,Y(IY))
CALL setderiv(OpenAD_Symbol_779,OM)
CALL sax(OpenAD_Symbol_778,OpenAD_Symbol_779,FAUX)
CALL saxpy(OpenAD_Symbol_780,OpenAD_Symbol_781,FAUX)
ELSE
IF(CARTESIAN) THEN
OpenAD_Symbol_101 = (Y(IY)%v-Y(MY)%v)
OpenAD_Symbol_106 = (F0%v+BETA%v*OpenAD_Symbol_101)
OpenAD_Symbol_99 = 1_w2f__i8
OpenAD_Symbol_102 = OpenAD_Symbol_101
OpenAD_Symbol_104 = 1_w2f__i8
OpenAD_Symbol_105 = (-1_w2f__i8)
OpenAD_Symbol_103 = BETA%v
OpenAD_Symbol_100 = 1_w2f__i8
FAUX%v = OpenAD_Symbol_106
OpenAD_Symbol_782 = (OpenAD_Symbol_102 * OpenAD_Symbol_100)
OpenAD_Symbol_784 = (OpenAD_Symbol_103 * OpenAD_Symbol_100)
OpenAD_Symbol_785 = (OpenAD_Symbol_104 * OpenAD_Symbol_784)
OpenAD_Symbol_787 = (OpenAD_Symbol_105 * OpenAD_Symbol_784)
OpenAD_Symbol_789 = OpenAD_Symbol_99
CALL setderiv(OpenAD_Symbol_790,F0)
CALL setderiv(OpenAD_Symbol_788,Y(MY))
CALL setderiv(OpenAD_Symbol_786,Y(IY))
CALL setderiv(OpenAD_Symbol_783,BETA)
CALL sax(OpenAD_Symbol_782,OpenAD_Symbol_783,FAUX)
CALL saxpy(OpenAD_Symbol_785,OpenAD_Symbol_786,FAUX)
CALL saxpy(OpenAD_Symbol_787,OpenAD_Symbol_788,FAUX)
CALL saxpy(OpenAD_Symbol_789,OpenAD_Symbol_790,FAUX)
ENDIF
ENDIF
DO IX = 0, 21, 1
FCORI(INT(IX),INT(IY))%v = FAUX%v
CALL setderiv(FCORI(IX,IY),FAUX)
END DO
END DO
DO IX = 1, 20, 1
DO IY = 1, 20, 1
FAUX%v = (VMASK(IX+(-1),IY+1)%v+VMASK(IX,IY+1)%v+VMASK(IX,IY)%
+v+VMASK(IX+(-1),IY)%v)
OpenAD_Symbol_107 = 1_w2f__i8
OpenAD_Symbol_109 = 1_w2f__i8
OpenAD_Symbol_111 = 1_w2f__i8
OpenAD_Symbol_112 = 1_w2f__i8
OpenAD_Symbol_110 = 1_w2f__i8
OpenAD_Symbol_108 = 1_w2f__i8
OpenAD_Symbol_791 = (OpenAD_Symbol_109 * OpenAD_Symbol_108)
OpenAD_Symbol_793 = (OpenAD_Symbol_110 * OpenAD_Symbol_108)
OpenAD_Symbol_794 = (OpenAD_Symbol_111 * OpenAD_Symbol_793)
OpenAD_Symbol_796 = (OpenAD_Symbol_112 * OpenAD_Symbol_793)
OpenAD_Symbol_798 = OpenAD_Symbol_107
CALL setderiv(OpenAD_Symbol_799,VMASK(IX+(-1),IY+1))
CALL setderiv(OpenAD_Symbol_797,VMASK(IX+(-1),IY))
CALL setderiv(OpenAD_Symbol_795,VMASK(IX,IY))
CALL setderiv(OpenAD_Symbol_792,VMASK(IX,IY+1))
CALL sax(OpenAD_Symbol_791,OpenAD_Symbol_792,FAUX)
CALL saxpy(OpenAD_Symbol_794,OpenAD_Symbol_795,FAUX)
CALL saxpy(OpenAD_Symbol_796,OpenAD_Symbol_797,FAUX)
CALL saxpy(OpenAD_Symbol_798,OpenAD_Symbol_799,FAUX)
IF (FAUX%v .eq. 0.0D00) THEN
FAUX%v = 0.0D00
CALL zero_deriv(FAUX)
ELSE
OpenAD_Symbol_142 = (UMASK(IX,IY)%v*2.5D-01)
OpenAD_Symbol_140 = 2.5D-01
FAUX%v = OpenAD_Symbol_142
OpenAD_Symbol_825 = OpenAD_Symbol_140
CALL setderiv(OpenAD_Symbol_826,UMASK(IX,IY))
CALL sax(OpenAD_Symbol_825,OpenAD_Symbol_826,FAUX)
ENDIF
OpenAD_Symbol_116 = (FCORI(IX,IY)%v+FCORI(IX+(-1),IY)%v)
OpenAD_Symbol_113 = (OpenAD_Symbol_116 * 5.0D-01)
OpenAD_Symbol_121 = (FAUX%v*OpenAD_Symbol_113)
OpenAD_Symbol_114 = OpenAD_Symbol_113
OpenAD_Symbol_119 = 1_w2f__i8
OpenAD_Symbol_120 = 1_w2f__i8
OpenAD_Symbol_117 = 5.0D-01
OpenAD_Symbol_115 = FAUX%v
FCORIU(INT(IX),INT(IY))%v = OpenAD_Symbol_121
OpenAD_Symbol_800 = (OpenAD_Symbol_117 * OpenAD_Symbol_115)
OpenAD_Symbol_801 = (OpenAD_Symbol_119 * OpenAD_Symbol_800)
OpenAD_Symbol_803 = (OpenAD_Symbol_120 * OpenAD_Symbol_800)
OpenAD_Symbol_805 = OpenAD_Symbol_114
CALL setderiv(OpenAD_Symbol_806,FAUX)
CALL setderiv(OpenAD_Symbol_804,FCORI(IX+(-1),IY))
CALL setderiv(OpenAD_Symbol_802,FCORI(IX,IY))
CALL sax(OpenAD_Symbol_801,OpenAD_Symbol_802,FCORIU(IX,IY))
CALL saxpy(OpenAD_Symbol_803,OpenAD_Symbol_804,FCORIU(IX,IY))
CALL saxpy(OpenAD_Symbol_805,OpenAD_Symbol_806,FCORIU(IX,IY))
FAUX%v = (UMASK(IX+1,IY+(-1))%v+UMASK(IX,IY+(-1))%v+UMASK(IX,I
+Y)%v+UMASK(IX+1,IY)%v)
OpenAD_Symbol_122 = 1_w2f__i8
OpenAD_Symbol_124 = 1_w2f__i8
OpenAD_Symbol_126 = 1_w2f__i8
OpenAD_Symbol_127 = 1_w2f__i8
OpenAD_Symbol_125 = 1_w2f__i8
OpenAD_Symbol_123 = 1_w2f__i8
OpenAD_Symbol_807 = (OpenAD_Symbol_124 * OpenAD_Symbol_123)
OpenAD_Symbol_809 = (OpenAD_Symbol_125 * OpenAD_Symbol_123)
OpenAD_Symbol_810 = (OpenAD_Symbol_126 * OpenAD_Symbol_809)
OpenAD_Symbol_812 = (OpenAD_Symbol_127 * OpenAD_Symbol_809)
OpenAD_Symbol_814 = OpenAD_Symbol_122
CALL setderiv(OpenAD_Symbol_815,UMASK(IX+1,IY+(-1)))
CALL setderiv(OpenAD_Symbol_813,UMASK(IX+1,IY))
CALL setderiv(OpenAD_Symbol_811,UMASK(IX,IY))
CALL setderiv(OpenAD_Symbol_808,UMASK(IX,IY+(-1)))
CALL sax(OpenAD_Symbol_807,OpenAD_Symbol_808,FAUX)
CALL saxpy(OpenAD_Symbol_810,OpenAD_Symbol_811,FAUX)
CALL saxpy(OpenAD_Symbol_812,OpenAD_Symbol_813,FAUX)
CALL saxpy(OpenAD_Symbol_814,OpenAD_Symbol_815,FAUX)
IF (FAUX%v .eq. 0.0D00) THEN
FAUX%v = 0.0D00
CALL zero_deriv(FAUX)
ELSE
OpenAD_Symbol_139 = (VMASK(IX,IY)%v*2.5D-01)
OpenAD_Symbol_137 = 2.5D-01
FAUX%v = OpenAD_Symbol_139
OpenAD_Symbol_823 = OpenAD_Symbol_137
CALL setderiv(OpenAD_Symbol_824,VMASK(IX,IY))
CALL sax(OpenAD_Symbol_823,OpenAD_Symbol_824,FAUX)
ENDIF
OpenAD_Symbol_131 = (FCORI(IX,IY)%v+FCORI(IX,IY+(-1))%v)
OpenAD_Symbol_128 = (OpenAD_Symbol_131 * 5.0D-01)
OpenAD_Symbol_136 = (FAUX%v*OpenAD_Symbol_128)
OpenAD_Symbol_129 = OpenAD_Symbol_128
OpenAD_Symbol_134 = 1_w2f__i8
OpenAD_Symbol_135 = 1_w2f__i8
OpenAD_Symbol_132 = 5.0D-01
OpenAD_Symbol_130 = FAUX%v
FCORIV(INT(IX),INT(IY))%v = OpenAD_Symbol_136
OpenAD_Symbol_816 = (OpenAD_Symbol_132 * OpenAD_Symbol_130)
OpenAD_Symbol_817 = (OpenAD_Symbol_134 * OpenAD_Symbol_816)
OpenAD_Symbol_819 = (OpenAD_Symbol_135 * OpenAD_Symbol_816)
OpenAD_Symbol_821 = OpenAD_Symbol_129
CALL setderiv(OpenAD_Symbol_822,FAUX)
CALL setderiv(OpenAD_Symbol_820,FCORI(IX,IY+(-1)))
CALL setderiv(OpenAD_Symbol_818,FCORI(IX,IY))
CALL sax(OpenAD_Symbol_817,OpenAD_Symbol_818,FCORIV(IX,IY))
CALL saxpy(OpenAD_Symbol_819,OpenAD_Symbol_820,FCORIV(IX,IY))
CALL saxpy(OpenAD_Symbol_821,OpenAD_Symbol_822,FCORIV(IX,IY))
END DO
END DO
RETURN
END SUBROUTINE
SUBROUTINE make_masks()
use w2f__types
use active_module
use size
use parms
use pfields
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
EXTERNAL boundary_conditions
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
type(active) :: MINDEPTH
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
C
C **** statements ****
C
MYNX = 20
MYNY = 20
DO IX = 1, 20, 1
DO IY = 1, 20, 1
IF (DEPTH(IX,IY)%v .LT. DEPTH(IX+(-1),IY)%v) THEN
MINDEPTH%v = DEPTH(IX,IY)%v
CALL setderiv(MINDEPTH,DEPTH(IX,IY))
ELSE
MINDEPTH%v = DEPTH(IX+(-1),IY)%v
CALL setderiv(MINDEPTH,DEPTH(IX+(-1),IY))
ENDIF
IF (MINDEPTH%v .ne. 0.0D00) THEN
UMASK(INT(IX),INT(IY))%v = 1.0D00
CALL zero_deriv(UMASK(INT(IX),INT(IY)))
ELSE
UMASK(INT(IX),INT(IY))%v = 0.0D00
CALL zero_deriv(UMASK(INT(IX),INT(IY)))
ENDIF
END DO
END DO
DO IX = 1, 20, 1
DO IY = 1, 20, 1
IF (DEPTH(IX,IY)%v .LT. DEPTH(IX,IY+(-1))%v) THEN
MINDEPTH%v = DEPTH(IX,IY)%v
CALL setderiv(MINDEPTH,DEPTH(IX,IY))
ELSE
MINDEPTH%v = DEPTH(IX,IY+(-1))%v
CALL setderiv(MINDEPTH,DEPTH(IX,IY+(-1)))
ENDIF
IF (MINDEPTH%v .ne. 0.0D00) THEN
VMASK(INT(IX),INT(IY))%v = 1.0D00
CALL zero_deriv(VMASK(INT(IX),INT(IY)))
ELSE
VMASK(INT(IX),INT(IY))%v = 0.0D00
CALL zero_deriv(VMASK(INT(IX),INT(IY)))
ENDIF
END DO
END DO
DO IX = 1, 20, 1
DO IY = 1, 20, 1
IF (DEPTH(IX,IY)%v .ne. 0.0D00) THEN
ETAMASK(INT(IX),INT(IY))%v = 1.0D00
CALL zero_deriv(ETAMASK(INT(IX),INT(IY)))
ELSE
ETAMASK(INT(IX),INT(IY))%v = 0.0D00
CALL zero_deriv(ETAMASK(INT(IX),INT(IY)))
ENDIF
END DO
END DO
CALL boundary_conditions(MYNX,MYNY,UMASK,XPERIODIC,YPERIODIC)
CALL boundary_conditions(MYNX,MYNY,VMASK,XPERIODIC,YPERIODIC)
RETURN
END SUBROUTINE
SUBROUTINE variance(NX, NY, F, FMASK, VARF)
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Global Variables ****
C
REAL(w2f__8) OpenAD_Symbol_143
REAL(w2f__8) OpenAD_Symbol_144
REAL(w2f__8) OpenAD_Symbol_145
REAL(w2f__8) OpenAD_Symbol_150
REAL(w2f__8) OpenAD_Symbol_146
REAL(w2f__8) OpenAD_Symbol_151
REAL(w2f__8) OpenAD_Symbol_152
REAL(w2f__8) OpenAD_Symbol_148
REAL(w2f__8) OpenAD_Symbol_153
REAL(w2f__8) OpenAD_Symbol_149
REAL(w2f__8) OpenAD_Symbol_154
REAL(w2f__8) OpenAD_Symbol_155
REAL(w2f__8) OpenAD_Symbol_160
REAL(w2f__8) OpenAD_Symbol_161
REAL(w2f__8) OpenAD_Symbol_157
REAL(w2f__8) OpenAD_Symbol_158
REAL(w2f__8) OpenAD_Symbol_163
REAL(w2f__8) OpenAD_Symbol_159
type(active) :: OpenAD_Symbol_830
REAL(w2f__8) OpenAD_Symbol_831
REAL(w2f__8) OpenAD_Symbol_827
type(active) :: OpenAD_Symbol_832
type(active) :: OpenAD_Symbol_828
REAL(w2f__8) OpenAD_Symbol_833
REAL(w2f__8) OpenAD_Symbol_829
type(active) :: OpenAD_Symbol_834
REAL(w2f__8) OpenAD_Symbol_835
type(active) :: OpenAD_Symbol_840
REAL(w2f__8) OpenAD_Symbol_836
REAL(w2f__8) OpenAD_Symbol_841
REAL(w2f__8) OpenAD_Symbol_837
type(active) :: OpenAD_Symbol_842
type(active) :: OpenAD_Symbol_838
REAL(w2f__8) OpenAD_Symbol_843
REAL(w2f__8) OpenAD_Symbol_839
type(active) :: OpenAD_Symbol_844
C
C **** Parameters and Result ****
C
INTEGER(w2f__i4) NX
INTEGER(w2f__i4) NY
type(active) :: F(1 : NX, 1 : NY)
type(active) :: FMASK(0 : INT((NX + 1)), 0 : INT((NY + 1)) )
type(active) :: VARF
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i8) t__20
INTEGER(w2f__i8) t__24
INTEGER(w2f__i8) t__21
INTEGER(w2f__i8) t__26
INTEGER(w2f__i8) t__22
INTEGER(w2f__i8) t__29
INTEGER(w2f__i8) t__23
INTEGER(w2f__i8) t__32
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) K
type(active) :: MEANF
INTEGER(w2f__i8) t__25
INTEGER(w2f__i8) t__27
INTEGER(w2f__i8) t__28
INTEGER(w2f__i8) t__30
INTEGER(w2f__i8) t__31
INTEGER(w2f__i8) t__33
C
C **** Temporary variables ****
C
INTEGER(w2f__i4) doloop_ub
INTEGER(w2f__i4) doloop_ub0
INTEGER(w2f__i4) doloop_ub1
INTEGER(w2f__i4) doloop_ub2
C
C **** statements ****
C
t__20 = NX
t__21 = NY
t__24 = MAX(t__20, 0_w2f__i8)
t__25 = t__24
t__26 = MAX(t__21, 0_w2f__i8)
t__27 = t__24 * t__26
t__22 = INT(NX + 1)
t__23 = INT(NY + 1)
t__28 = t__22 + 1_w2f__i8
t__29 = MAX(t__28, 0_w2f__i8)
t__30 = t__29
t__31 = t__23 + 1_w2f__i8
t__32 = MAX(t__31, 0_w2f__i8)
t__33 = t__29 * t__32
VARF%v = 0.0D00
MEANF%v = 0.0D00
CALL zero_deriv(VARF)
CALL zero_deriv(MEANF)
K = 0
doloop_ub = NY
DO IY = 1, doloop_ub, 1
doloop_ub0 = NX
DO IX = 1, doloop_ub0, 1
IF (FMASK(IX,IY)%v .ne. 0.0D00) THEN
MEANF%v = (F(IX,IY)%v+MEANF%v)
OpenAD_Symbol_143 = 1_w2f__i8
OpenAD_Symbol_144 = 1_w2f__i8
OpenAD_Symbol_827 = OpenAD_Symbol_143
OpenAD_Symbol_829 = OpenAD_Symbol_144
CALL setderiv(OpenAD_Symbol_830,MEANF)
CALL setderiv(OpenAD_Symbol_828,F(IX,IY))
CALL sax(OpenAD_Symbol_827,OpenAD_Symbol_828,MEANF)
CALL saxpy(OpenAD_Symbol_829,OpenAD_Symbol_830,MEANF)
K = K + 1
ENDIF
END DO
END DO
IF(K .ne. INT(0_w2f__i8)) THEN
OpenAD_Symbol_145 = REAL(K)
OpenAD_Symbol_148 = (MEANF%v/OpenAD_Symbol_145)
OpenAD_Symbol_146 = (INT(1_w2f__i8) / OpenAD_Symbol_145)
MEANF%v = OpenAD_Symbol_148
OpenAD_Symbol_831 = OpenAD_Symbol_146
CALL setderiv(OpenAD_Symbol_832,MEANF)
CALL sax(OpenAD_Symbol_831,OpenAD_Symbol_832,MEANF)
ENDIF
doloop_ub1 = NY
DO IY = 1, doloop_ub1, 1
doloop_ub2 = NX
DO IX = 1, doloop_ub2, 1
OpenAD_Symbol_154 = (F(IX,IY)%v-MEANF%v)
OpenAD_Symbol_151 = (OpenAD_Symbol_154 ** INT(2_w2f__i8))
OpenAD_Symbol_159 = (VARF%v+FMASK(IX,IY)%v*OpenAD_Symbol_151)
OpenAD_Symbol_149 = 1_w2f__i8
OpenAD_Symbol_152 = OpenAD_Symbol_151
OpenAD_Symbol_157 = 1_w2f__i8
OpenAD_Symbol_158 = (-1_w2f__i8)
OpenAD_Symbol_155 = (INT(2_w2f__i8) *(OpenAD_Symbol_154 **(
> INT(2_w2f__i8) - INT(1_w2f__i8))))
OpenAD_Symbol_153 = FMASK(IX,IY)%v
OpenAD_Symbol_150 = 1_w2f__i8
VARF%v = OpenAD_Symbol_159
OpenAD_Symbol_833 = (OpenAD_Symbol_152 * OpenAD_Symbol_150)
OpenAD_Symbol_835 = (OpenAD_Symbol_153 * OpenAD_Symbol_150)
OpenAD_Symbol_836 = (OpenAD_Symbol_155 * OpenAD_Symbol_835)
OpenAD_Symbol_837 = (OpenAD_Symbol_157 * OpenAD_Symbol_836)
OpenAD_Symbol_839 = (OpenAD_Symbol_158 * OpenAD_Symbol_836)
OpenAD_Symbol_841 = OpenAD_Symbol_149
CALL setderiv(OpenAD_Symbol_842,VARF)
CALL setderiv(OpenAD_Symbol_840,MEANF)
CALL setderiv(OpenAD_Symbol_838,F(IX,IY))
CALL setderiv(OpenAD_Symbol_834,FMASK(IX,IY))
CALL sax(OpenAD_Symbol_833,OpenAD_Symbol_834,VARF)
CALL saxpy(OpenAD_Symbol_837,OpenAD_Symbol_838,VARF)
CALL saxpy(OpenAD_Symbol_839,OpenAD_Symbol_840,VARF)
CALL saxpy(OpenAD_Symbol_841,OpenAD_Symbol_842,VARF)
END DO
END DO
IF(K .GT. INT(1_w2f__i8)) THEN
OpenAD_Symbol_160 = REAL(K + INT((-1_w2f__i8)))
OpenAD_Symbol_163 = (VARF%v/OpenAD_Symbol_160)
OpenAD_Symbol_161 = (INT(1_w2f__i8) / OpenAD_Symbol_160)
VARF%v = OpenAD_Symbol_163
OpenAD_Symbol_843 = OpenAD_Symbol_161
CALL setderiv(OpenAD_Symbol_844,VARF)
CALL sax(OpenAD_Symbol_843,OpenAD_Symbol_844,VARF)
ENDIF
RETURN
END SUBROUTINE
SUBROUTINE check_cfl()
use w2f__types
use active_module
use size
use parms
use pfields
IMPLICIT NONE
C
C **** Global Variables ****
C
REAL(w2f__8) OpenAD_Symbol_61
REAL(w2f__8) OpenAD_Symbol_57
REAL(w2f__8) OpenAD_Symbol_62
REAL(w2f__8) OpenAD_Symbol_58
REAL(w2f__8) OpenAD_Symbol_63
REAL(w2f__8) OpenAD_Symbol_59
REAL(w2f__8) OpenAD_Symbol_64
REAL(w2f__8) OpenAD_Symbol_65
REAL(w2f__8) OpenAD_Symbol_70
REAL(w2f__8) OpenAD_Symbol_66
REAL(w2f__8) OpenAD_Symbol_71
REAL(w2f__8) OpenAD_Symbol_67
REAL(w2f__8) OpenAD_Symbol_72
REAL(w2f__8) OpenAD_Symbol_68
REAL(w2f__8) OpenAD_Symbol_69
REAL(w2f__8) OpenAD_Symbol_752
type(active) :: OpenAD_Symbol_753
REAL(w2f__8) OpenAD_Symbol_754
REAL(w2f__8) OpenAD_Symbol_755
REAL(w2f__8) OpenAD_Symbol_760
REAL(w2f__8) OpenAD_Symbol_756
REAL(w2f__8) OpenAD_Symbol_761
REAL(w2f__8) OpenAD_Symbol_757
type(active) :: OpenAD_Symbol_762
type(active) :: OpenAD_Symbol_758
REAL(w2f__8) OpenAD_Symbol_763
REAL(w2f__8) OpenAD_Symbol_759
type(active) :: OpenAD_Symbol_764
C
C **** Local Variables and functions ****
C
type(active) :: CFLX
type(active) :: CFLY
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
type(active) :: MAXIMUM
type(active) :: MDEP
type(active) :: MDX
type(active) :: MDY
type(active) :: MINIMUM
type(active) :: WAVESPEED
C
C **** statements ****
C
MDEP%v = 0.0D00
MDX%v = 9.99999999999999916114D+22
MDY%v = 9.99999999999999916114D+22
CALL zero_deriv(MDEP)
CALL zero_deriv(MDX)
CALL zero_deriv(MDY)
DO IX = 1, 20, 1
IF (DX(IX)%v .GT. MDX%v) THEN
MINIMUM%v = MDX%v
CALL setderiv(MINIMUM,MDX)
ELSE
MINIMUM%v = DX(IX)%v
CALL setderiv(MINIMUM,DX(IX))
ENDIF
MDX%v = MINIMUM%v
CALL setderiv(MDX,MINIMUM)
END DO
DO IY = 1, 20, 1
IF (DY(IY)%v .GT. MDY%v) THEN
MINIMUM%v = MDY%v
CALL setderiv(MINIMUM,MDY)
ELSE
MINIMUM%v = DY(IY)%v
CALL setderiv(MINIMUM,DY(IY))
ENDIF
MDY%v = MINIMUM%v
CALL setderiv(MDY,MINIMUM)
END DO
DO IX = 1, 20, 1
DO IY = 1, 20, 1
IF (DEPTH(IX,IY)%v .LT. MDEP%v) THEN
MAXIMUM%v = MDEP%v
CALL setderiv(MAXIMUM,MDEP)
ELSE
MAXIMUM%v = DEPTH(IX,IY)%v
CALL setderiv(MAXIMUM,DEPTH(IX,IY))
ENDIF
MDEP%v = MAXIMUM%v
CALL setderiv(MDEP,MAXIMUM)
END DO
END DO
OpenAD_Symbol_57 = SQRT(MDEP%v*9.81000000000000049738D00)
OpenAD_Symbol_59 = 9.81000000000000049738D00
OpenAD_Symbol_58 = (5.0D-01 / OpenAD_Symbol_57)
WAVESPEED%v = OpenAD_Symbol_57
OpenAD_Symbol_61 = (WAVESPEED%v*DT%v)
OpenAD_Symbol_66 = (OpenAD_Symbol_61/MDX%v)
OpenAD_Symbol_64 = DT%v
OpenAD_Symbol_65 = WAVESPEED%v
OpenAD_Symbol_62 = (INT(1 _w2f__i8)/MDX%v)
OpenAD_Symbol_63 = (-(OpenAD_Symbol_61/(MDX%v*MDX%v)))
CFLX%v = OpenAD_Symbol_66
OpenAD_Symbol_67 = (WAVESPEED%v*DT%v)
OpenAD_Symbol_72 = (OpenAD_Symbol_67/MDY%v)
OpenAD_Symbol_70 = DT%v
OpenAD_Symbol_71 = WAVESPEED%v
OpenAD_Symbol_68 = (INT(1 _w2f__i8)/MDY%v)
OpenAD_Symbol_69 = (-(OpenAD_Symbol_67/(MDY%v*MDY%v)))
CFLY%v = OpenAD_Symbol_72
OpenAD_Symbol_752 = (OpenAD_Symbol_59 * OpenAD_Symbol_58)
OpenAD_Symbol_754 = (OpenAD_Symbol_752 * OpenAD_Symbol_64)
OpenAD_Symbol_755 = (OpenAD_Symbol_752 * OpenAD_Symbol_70)
OpenAD_Symbol_756 = (OpenAD_Symbol_754 * OpenAD_Symbol_62)
OpenAD_Symbol_757 = (OpenAD_Symbol_65 * OpenAD_Symbol_62)
OpenAD_Symbol_759 = (OpenAD_Symbol_755 * OpenAD_Symbol_68)
OpenAD_Symbol_760 = (OpenAD_Symbol_71 * OpenAD_Symbol_68)
OpenAD_Symbol_761 = OpenAD_Symbol_63
OpenAD_Symbol_763 = OpenAD_Symbol_69
CALL setderiv(OpenAD_Symbol_764,MDY)
CALL setderiv(OpenAD_Symbol_762,MDX)
CALL setderiv(OpenAD_Symbol_758,DT)
CALL setderiv(OpenAD_Symbol_753,MDEP)
CALL sax(OpenAD_Symbol_752,OpenAD_Symbol_753,WAVESPEED)
CALL sax(OpenAD_Symbol_756,OpenAD_Symbol_753,CFLX)
CALL saxpy(OpenAD_Symbol_757,OpenAD_Symbol_758,CFLX)
CALL sax(OpenAD_Symbol_759,OpenAD_Symbol_753,CFLY)
CALL saxpy(OpenAD_Symbol_760,OpenAD_Symbol_758,CFLY)
CALL saxpy(OpenAD_Symbol_761,OpenAD_Symbol_762,CFLX)
CALL saxpy(OpenAD_Symbol_763,OpenAD_Symbol_764,CFLY)
WRITE(*, *) 'rough check of CLF criterion:'
IF ((CFLX%v .GE. 1.0D00) .OR. (CFLY%v .GE. 1.0D00)) THEN
WRITE(*, *) 'warning: CLF criterion not met'
WRITE(*,*)'sqrt(g*max(depth))*dt/min(dx) = ',CFLX%v
WRITE(*,*)'sqrt(g*max(depth))*dt/min(dy) = ',CFLY%v
ELSE
WRITE(*, *) 'OK'
ENDIF
RETURN
END SUBROUTINE
SUBROUTINE read_extended_field(NCDATAFILE, FNAME, FIELD)
use w2f__types
use active_module
use size
IMPLICIT NONE
C
C **** Parameters and Result ****
C
CHARACTER(80) NCDATAFILE
CHARACTER(80) FNAME
type(active) :: FIELD(0 : 21, 0 : 21)
C
C **** Local Variables and functions ****
C
type(active) :: F_IN(1 : 20, 1 : 20)
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
EXTERNAL read_field_netcdf
C
C **** statements ****
C
MYNX = 20
MYNY = 20
DO IX = 1, 20, 1
DO IY = 1, 20, 1
F_IN(INT(IX),INT(IY))%v = 0.0D00
CALL zero_deriv(F_IN(INT(IX),INT(IY)))
END DO
END DO
CALL read_field_netcdf(NCDATAFILE,FNAME,MYNX,MYNY,F_IN)
DO IX = 1, 20, 1
DO IY = 1, 20, 1
FIELD(INT(IX),INT(IY))%v = F_IN(IX,IY)%v
CALL setderiv(FIELD(IX,IY),F_IN(IX,IY))
END DO
END DO
RETURN
END SUBROUTINE
SUBROUTINE read_field(NCDATAFILE, START_TIME, FNAME, FIELD)
use w2f__types
use active_module
use size
IMPLICIT NONE
C
C **** Parameters and Result ****
C
CHARACTER(80) NCDATAFILE
type(active) :: START_TIME
CHARACTER(80) FNAME
type(active) :: FIELD(1 : 20, 1 : 20)
C
C **** Local Variables and functions ****
C
type(active) :: F_IN(1 : 20, 1 : 20)
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) MYNX
SAVE MYNX
INTEGER(w2f__i4) MYNY
SAVE MYNY
EXTERNAL read_field_netcdf
EXTERNAL read_snap_netcdf
C
C **** Initializers ****
C
DATA MYNX / 20 /
DATA MYNY / 20 /
C
C **** statements ****
C
DO IX = 1, 20, 1
DO IY = 1, 20, 1
F_IN(INT(IX),INT(IY))%v = 0.0D00
CALL zero_deriv(F_IN(INT(IX),INT(IY)))
END DO
END DO
IF (START_TIME%v .LE. 0.0D00) THEN
CALL read_field_netcdf(NCDATAFILE,FNAME,MYNX,MYNY,F_IN)
ELSE
CALL read_snap_netcdf(NCDATAFILE,START_TIME,MYNX,MYNY,FNAME,F_IN
+)
ENDIF
DO IX = 1, 20, 1
DO IY = 1, 20, 1
FIELD(INT(IX),INT(IY))%v = F_IN(IX,IY)%v
CALL setderiv(FIELD(IX,IY),F_IN(IX,IY))
END DO
END DO
RETURN
END SUBROUTINE
SUBROUTINE boundary_conditions(NX, NY, FIELD, XPERIODIC,
> YPERIODIC)
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Parameters and Result ****
C
INTEGER(w2f__i4) NX
INTEGER(w2f__i4) NY
type(active) :: FIELD(0 : INT((NX + 1)), 0 : INT((NY + 1)) )
LOGICAL(w2f__i4) XPERIODIC
LOGICAL(w2f__i4) YPERIODIC
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i8) t__40
INTEGER(w2f__i8) t__43
INTEGER(w2f__i8) t__41
INTEGER(w2f__i8) t__46
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i8) t__42
INTEGER(w2f__i8) t__44
INTEGER(w2f__i8) t__45
INTEGER(w2f__i8) t__47
C
C **** Temporary variables ****
C
INTEGER(w2f__i4) doloop_ub
INTEGER(w2f__i4) doloop_ub0
INTEGER(w2f__i4) doloop_ub1
INTEGER(w2f__i4) doloop_ub2
C
C **** statements ****
C
t__40 = INT(NX + 1)
t__41 = INT(NY + 1)
t__42 = t__40 + 1_w2f__i8
t__43 = MAX(t__42, 0_w2f__i8)
t__44 = t__43
t__45 = t__41 + 1_w2f__i8
t__46 = MAX(t__45, 0_w2f__i8)
t__47 = t__43 * t__46
IF(XPERIODIC) THEN
doloop_ub = NY + 1
DO IY = 0, doloop_ub, 1
FIELD(0,INT(IY))%v = FIELD(NX,IY)%v
CALL setderiv(FIELD(0,IY),FIELD(NX,IY))
FIELD(INT(NX+1),INT(IY))%v = FIELD(1,IY)%v
CALL setderiv(FIELD(NX+1,IY),FIELD(1,IY))
END DO
ELSE
doloop_ub0 = NY + 1
DO IY = 0, doloop_ub0, 1
FIELD(0,INT(IY))%v = 0.0D00
FIELD(INT(NX+1),INT(IY))%v = 0.0D00
CALL zero_deriv(FIELD(0,INT(IY)))
CALL zero_deriv(FIELD(INT(NX+1),INT(IY)))
END DO
ENDIF
IF(YPERIODIC) THEN
doloop_ub1 = NX + 1
DO IX = 0, doloop_ub1, 1
FIELD(INT(IX),0)%v = FIELD(IX,NY)%v
CALL setderiv(FIELD(IX,0),FIELD(IX,NY))
FIELD(INT(IX),INT(NY+1))%v = FIELD(IX,1)%v
CALL setderiv(FIELD(IX,NY+1),FIELD(IX,1))
END DO
ELSE
doloop_ub2 = NX + 1
DO IX = 0, doloop_ub2, 1
FIELD(INT(IX),0)%v = 0.0D00
FIELD(INT(IX),INT(NY+1))%v = 0.0D00
CALL zero_deriv(FIELD(INT(IX),0))
CALL zero_deriv(FIELD(INT(IX),INT(NY+1)))
END DO
ENDIF
IF(XPERIODIC .AND. YPERIODIC) THEN
WRITE(*, *) 'boundary_conditions: ',
> 'make sure that the corners are handled correctly'
ENDIF
RETURN
END SUBROUTINE
SUBROUTINE ini_io()
use w2f__types
use active_module
use size
use parms
use pfields
use weights
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
EXTERNAL add_coordinates_netcdf
EXTERNAL add_gatta_netcdf
EXTERNAL add_gatti_netcdf
EXTERNAL add_gattr_netcdf
EXTERNAL add_recvar_netcdf
EXTERNAL create_netcdf
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
type(active) :: MYEARTH
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
CHARACTER(80) STR1
CHARACTER(80) STR2
CHARACTER(80) STR3
CHARACTER(80) STR4
type(active) :: XOUT(1 : 20)
type(active) :: YOUT(1 : 20)
C
C **** statements ****
C
MYNX = 20
MYNY = 20
MYEARTH%v = 6.371D+06
CALL zero_deriv(MYEARTH)
IF(FULLIO) THEN
WRITE(*, *) 'initializing I/O'
ENDIF
CALL create_netcdf(FOUTNAME, RUNNAME, MYNX, MYNY)
IF(SPHERICAL) THEN
STR1 = 'grid_type'
STR2 = 'spherical'
STR3 = 'earth_radius'
STR4 = 'Omega'
CALL add_gatta_netcdf(FOUTNAME, STR1, STR2)
CALL add_gattr_netcdf(FOUTNAME,STR3,MYEARTH)
CALL add_gattr_netcdf(FOUTNAME,STR4,OM)
ELSE
IF(CARTESIAN) THEN
STR1 = 'grid_type'
STR2 = 'cartesian'
STR3 = 'f0'
STR4 = 'beta'
CALL add_gatta_netcdf(FOUTNAME, STR1, STR2)
CALL add_gattr_netcdf(FOUTNAME,STR3,F0)
CALL add_gattr_netcdf(FOUTNAME,STR4,BETA)
ENDIF
ENDIF
STR1 = 'r_ini'
STR2 = 'time_step'
CALL add_gattr_netcdf(FOUTNAME,STR1,RINI)
CALL add_gattr_netcdf(FOUTNAME,STR2,DT)
IF(XPERIODIC) THEN
STR1 = 'zonal_boundary_conditions'
STR2 = 'periodic'
CALL add_gatta_netcdf(FOUTNAME, STR1, STR2)
ENDIF
IF(YPERIODIC) THEN
STR1 = 'meridional_boundary_conditions'
STR2 = 'periodic'
CALL add_gatta_netcdf(FOUTNAME, STR1, STR2)
ENDIF
STR1 = 'data_files'
STR2 = NCDATAFILE // ' ' // DEPTHFILE // ' ' // FORCINGFILE //
> ' ' // UINIFILE // ' ' // VINIFILE // ' ' // ETAINIFILE
CALL add_gatta_netcdf(FOUTNAME, STR1, STR2)
IF (START_TIME%v .ne. 0.0D00) THEN
STR1 = 'restart_file'
CALL add_gatta_netcdf(FOUTNAME, STR1, NCRESTARTFILE)
ENDIF
STR1 = 'ntspinup'
STR2 = 'wf_depth'
STR3 = 'wf_eta'
STR4 = 'wf_u'
CALL add_gatti_netcdf(FOUTNAME, STR1, NTSPINUP)
CALL add_gattr_netcdf(FOUTNAME,STR2,WF_DEPTH)
CALL add_gattr_netcdf(FOUTNAME,STR3,WF_ETA)
CALL add_gattr_netcdf(FOUTNAME,STR4,WF_U)
STR1 = 'wf_v'
STR2 = 'wf_lapldepth'
STR3 = 'wf_graddepth'
STR4 = 'wf_zonal_transport'
CALL add_gattr_netcdf(FOUTNAME,STR1,WF_V)
CALL add_gattr_netcdf(FOUTNAME,STR2,WF_LAPLDEPTH)
CALL add_gattr_netcdf(FOUTNAME,STR3,WF_GRADDEPTH)
CALL add_gattr_netcdf(FOUTNAME,STR4,WF_ZONAL_TRANSPORT)
DO IX = 1, 20, 1
XOUT(INT(IX))%v = X(IX)%v
CALL setderiv(XOUT(IX),X(IX))
END DO
DO IY = 1, 20, 1
YOUT(INT(IY))%v = Y(IY)%v
CALL setderiv(YOUT(IY),Y(IY))
END DO
IF(SPHERICAL) THEN
STR1 = 'deg'
CALL add_coordinates_netcdf(FOUTNAME,MYNX,XOUT,MYNY,YOUT,STR1)
ELSE
IF(CARTESIAN) THEN
STR1 = 'meters'
CALL add_coordinates_netcdf(FOUTNAME,MYNX,XOUT,MYNY,YOUT,STR1)
ENDIF
ENDIF
STR1 = 'U'
STR2 = 'zonal velocity'
STR3 = 'meters/seconds'
CALL add_recvar_netcdf(FOUTNAME, STR1, STR2, STR3)
STR1 = 'V'
STR2 = 'meridional velocity'
CALL add_recvar_netcdf(FOUTNAME, STR1, STR2, STR3)
STR1 = 'ETA'
STR2 = 'sea-surface elevation'
STR3 = 'meters'
CALL add_recvar_netcdf(FOUTNAME, STR1, STR2, STR3)
RETURN
END SUBROUTINE
SUBROUTINE state_io(TIME, NIO)
use w2f__types
use active_module
use size
use parms
use pfields
use vars
IMPLICIT NONE
C
C **** Global Variables ****
C
REAL(w2f__8) OpenAD_Symbol_164
REAL(w2f__8) OpenAD_Symbol_166
REAL(w2f__8) OpenAD_Symbol_168
REAL(w2f__8) OpenAD_Symbol_845
type(active) :: OpenAD_Symbol_850
type(active) :: OpenAD_Symbol_846
REAL(w2f__8) OpenAD_Symbol_847
type(active) :: OpenAD_Symbol_848
REAL(w2f__8) OpenAD_Symbol_849
C
C **** Parameters and Result ****
C
type(active) :: TIME
INTEGER(w2f__i4) NIO
C
C **** Local Variables and functions ****
C
type(active) :: ETAOUT(1 : 20, 1 : 20)
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
CHARACTER(80) STR1
CHARACTER(80) STR2
type(active) :: UOUT(1 : 20, 1 : 20)
type(active) :: VOUT(1 : 20, 1 : 20)
EXTERNAL write_state_netcdf
C
C **** statements ****
C
MYNX = 20
MYNY = 20
DO IX = 1, 20, 1
DO IY = 1, 20, 1
UOUT(INT(IX),INT(IY))%v = (U(IX,IY)%v+REAL(INT(INT(UMASK(IX,IY
+)%v))+INT((-1 _w2f__i8)))*9.9D+01)
OpenAD_Symbol_164 = 1_w2f__i8
OpenAD_Symbol_845 = OpenAD_Symbol_164
CALL setderiv(OpenAD_Symbol_846,U(IX,IY))
CALL sax(OpenAD_Symbol_845,OpenAD_Symbol_846,UOUT(IX,IY))
VOUT(INT(IX),INT(IY))%v = (V(IX,IY)%v+REAL(INT(INT(VMASK(IX,IY
+)%v))+INT((-1 _w2f__i8)))*9.9D+01)
OpenAD_Symbol_166 = 1_w2f__i8
OpenAD_Symbol_847 = OpenAD_Symbol_166
CALL setderiv(OpenAD_Symbol_848,V(IX,IY))
CALL sax(OpenAD_Symbol_847,OpenAD_Symbol_848,VOUT(IX,IY))
ETAOUT(INT(IX),INT(IY))%v = (ETA(IX,IY)%v+REAL(INT(INT(ETAMASK
+(IX,IY)%v))+INT((-1 _w2f__i8)))*9.9D+01)
OpenAD_Symbol_168 = 1_w2f__i8
OpenAD_Symbol_849 = OpenAD_Symbol_168
CALL setderiv(OpenAD_Symbol_850,ETA(IX,IY))
CALL sax(OpenAD_Symbol_849,OpenAD_Symbol_850,ETAOUT(IX,IY))
END DO
END DO
STR1 = 'TIME'
STR2 = 'U'
CALL write_state_netcdf(FOUTNAME,MYNX,MYNY,NIO,STR1,TIME)
CALL write_state_netcdf(FOUTNAME,MYNX,MYNY,NIO,STR2,UOUT)
STR1 = 'V'
STR2 = 'ETA'
CALL write_state_netcdf(FOUTNAME,MYNX,MYNY,NIO,STR1,VOUT)
CALL write_state_netcdf(FOUTNAME,MYNX,MYNY,NIO,STR2,ETAOUT)
RETURN
END SUBROUTINE
SUBROUTINE pfields_io()
use w2f__types
use active_module
use size
use parms
use pfields
use force
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
EXTERNAL add_pfield_netcdf
type(active) :: AUX(1 : 20, 1 : 20)
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
CHARACTER(80) STR1
CHARACTER(80) STR2
CHARACTER(80) STR3
C
C **** statements ****
C
MYNX = 20
MYNY = 20
DO IX = 1, 20, 1
DO IY = 1, 20, 1
AUX(INT(IX),INT(IY))%v = DEPTH(IX,IY)%v
CALL setderiv(AUX(IX,IY),DEPTH(IX,IY))
END DO
END DO
STR1 = 'depth'
STR2 = 'water depth'
STR3 = 'meters'
CALL add_pfield_netcdf(FOUTNAME,MYNX,MYNY,AUX,STR1,STR2,STR3)
DO IX = 1, 20, 1
DO IY = 1, 20, 1
AUX(INT(IX),INT(IY))%v = UFORCE(IX,IY)%v
CALL setderiv(AUX(IX,IY),UFORCE(IX,IY))
END DO
END DO
STR1 = 'uforce'
STR2 = 'zonal forcing'
STR3 = 'forcing units'
CALL add_pfield_netcdf(FOUTNAME,MYNX,MYNY,AUX,STR1,STR2,STR3)
DO IX = 1, 20, 1
DO IY = 1, 20, 1
AUX(INT(IX),INT(IY))%v = VFORCE(IX,IY)%v
CALL setderiv(AUX(IX,IY),VFORCE(IX,IY))
END DO
END DO
STR1 = 'vforce'
STR2 = 'meridional forcing'
STR3 = 'forcing units'
CALL add_pfield_netcdf(FOUTNAME,MYNX,MYNY,AUX,STR1,STR2,STR3)
DO IX = 1, 20, 1
DO IY = 1, 20, 1
AUX(INT(IX),INT(IY))%v = FRICT(IX,IY)%v
CALL setderiv(AUX(IX,IY),FRICT(IX,IY))
END DO
END DO
STR1 = 'frict'
STR2 = 'linear bottom friction coefficient'
STR3 = '1/seconds'
CALL add_pfield_netcdf(FOUTNAME,MYNX,MYNY,AUX,STR1,STR2,STR3)
RETURN
END SUBROUTINE
SUBROUTINE save_gradient_io(N, ADXC, GNAME)
use w2f__types
use active_module
use size
use parms
use pfields
IMPLICIT NONE
C
C **** Parameters and Result ****
C
INTEGER(w2f__i4) N
type(active) :: ADXC(1 : N)
CHARACTER(80) GNAME
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i8) t__54
INTEGER(w2f__i8) t__57
EXTERNAL add_pfield_netcdf
type(active) :: GRAD(1 : 20, 1 : 20)
EXTERNAL map_gradient
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
CHARACTER(80) STR1
CHARACTER(80) STR2
C
C **** statements ****
C
t__54 = N
t__57 = MAX(t__54, 0_w2f__i8)
MYNX = 20
MYNY = 20
CALL map_gradient(N,ADXC,GRAD)
STR1 = 'gradient of cost function with respect to depth'
STR2 = 'cost function units/m'
CALL add_pfield_netcdf(FOUTNAME,MYNX,MYNY,GRAD,GNAME,STR1,STR2)
SUPPRESSIO = .TRUE.
RETURN
END SUBROUTINE
SUBROUTINE save_depth_io(N, XC, DNAME)
use w2f__types
use active_module
use size
use parms
use pfields
IMPLICIT NONE
C
C **** Parameters and Result ****
C
INTEGER(w2f__i4) N
type(active) :: XC(1 : N)
CHARACTER(80) DNAME
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i8) t__58
INTEGER(w2f__i8) t__61
EXTERNAL add_pfield_netcdf
type(active) :: AUX(1 : 20, 1 : 20)
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
EXTERNAL map_from_control_vector
INTEGER(w2f__i4) MYNX
INTEGER(w2f__i4) MYNY
CHARACTER(80) STR1
CHARACTER(80) STR2
C
C **** statements ****
C
t__58 = N
t__61 = MAX(t__58, 0_w2f__i8)
MYNX = 20
MYNY = 20
CALL map_from_control_vector(N,XC)
DO IX = 1, 20, 1
DO IY = 1, 20, 1
AUX(INT(IX),INT(IY))%v = DEPTH(IX,IY)%v
CALL setderiv(AUX(IX,IY),DEPTH(IX,IY))
END DO
END DO
STR1 = 'water depth after optimization'
STR2 = 'm'
CALL add_pfield_netcdf(FOUTNAME,MYNX,MYNY,AUX,DNAME,STR1,STR2)
SUPPRESSIO = .TRUE.
RETURN
END SUBROUTINE
SUBROUTINE inimini_io()
use w2f__types
use active_module
IMPLICIT NONE
C
C **** statements ****
C
RETURN
END SUBROUTINE
SUBROUTINE save_weights_io()
use w2f__types
use active_module
use size
use parms
use weights
IMPLICIT NONE
C
C **** Local Variables and functions ****
C
EXTERNAL add_gattr_netcdf
CHARACTER(80) STR1
C
C **** statements ****
C
STR1 = 'wf_depth'
CALL add_gattr_netcdf(FOUTNAME,STR1,WF_DEPTH)
STR1 = 'wf_eta'
CALL add_gattr_netcdf(FOUTNAME,STR1,WF_ETA)
STR1 = 'wf_zonal_transport'
CALL add_gattr_netcdf(FOUTNAME,STR1,WF_ZONAL_TRANSPORT)
RETURN
END SUBROUTINE
SUBROUTINE create_netcdf(FNAME, TNAME, NX, NY)
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Parameters and Result ****
C
CHARACTER(80) FNAME
CHARACTER(80) TNAME
INTEGER(w2f__i4) NX
INTEGER(w2f__i4) NY
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) DID
INTEGER(w2f__i4) ERRMSG
INTEGER(w2f__i4) FID
INTEGER(w2f__i4) FILBYTE
PARAMETER ( FILBYTE = -127)
INTEGER(w2f__i4) FILCHAR
PARAMETER ( FILCHAR = 0)
REAL(w2f__8) FILDOUB
PARAMETER ( FILDOUB = 9.969209968386869d+36)
REAL(w2f__4) FILFLOAT
PARAMETER ( FILFLOAT = 9.969210d+36)
INTEGER(w2f__i4) FILLONG
PARAMETER ( FILLONG = -2147483647)
INTEGER(w2f__i4) FILSHORT
PARAMETER ( FILSHORT = -32767)
EXTERNAL handle_err
EXTERNAL lastchar
INTEGER(w2f__i4) lastchar
INTEGER(w2f__i4) LCHAR
INTEGER(w2f__i4) MAXNCATT
PARAMETER ( MAXNCATT = 2000)
INTEGER(w2f__i4) MAXNCDIM
PARAMETER ( MAXNCDIM = 100)
INTEGER(w2f__i4) MAXNCNAM
PARAMETER ( MAXNCNAM = 128)
INTEGER(w2f__i4) MAXNCOP
PARAMETER ( MAXNCOP = 32)
INTEGER(w2f__i4) MAXNCVAR
PARAMETER ( MAXNCVAR = 2000)
INTEGER(w2f__i4) MAXVDIMS
PARAMETER ( MAXVDIMS = 100)
INTEGER(w2f__i4) NCBYTE
PARAMETER ( NCBYTE = 1)
INTEGER(w2f__i4) NCCHAR
PARAMETER ( NCCHAR = 2)
INTEGER(w2f__i4) NCCLOB
PARAMETER ( NCCLOB = 0)
INTEGER(w2f__i4) NCCREAT
PARAMETER ( NCCREAT = 2)
INTEGER(w2f__i4) NCDOUBLE
PARAMETER ( NCDOUBLE = 6)
INTEGER(w2f__i4) NCEBADD
PARAMETER ( NCEBADD = -46)
INTEGER(w2f__i4) NCEBADID
PARAMETER ( NCEBADID = -33)
INTEGER(w2f__i4) NCEBADTY
PARAMETER ( NCEBADTY = -45)
INTEGER(w2f__i4) NCECOORD
PARAMETER ( NCECOORD = -40)
INTEGER(w2f__i4) NCEEXIST
PARAMETER ( NCEEXIST = -35)
INTEGER(w2f__i4) NCEGLOB
PARAMETER ( NCEGLOB = -50)
INTEGER(w2f__i4) NCEINDEF
PARAMETER ( NCEINDEF = -39)
INTEGER(w2f__i4) NCEINVAL
PARAMETER ( NCEINVAL = -36)
INTEGER(w2f__i4) NCEMAXAT
PARAMETER ( NCEMAXAT = -44)
INTEGER(w2f__i4) NCEMAXDS
PARAMETER ( NCEMAXDS = -41)
INTEGER(w2f__i4) NCEMAXVS
PARAMETER ( NCEMAXVS = -48)
INTEGER(w2f__i4) NCENAME
PARAMETER ( NCENAME = -42)
INTEGER(w2f__i4) NCENFILE
PARAMETER ( NCENFILE = -31)
INTEGER(w2f__i4) NCENOATT
PARAMETER ( NCENOATT = -43)
INTEGER(w2f__i4) NCENOTIN
PARAMETER ( NCENOTIN = -38)
INTEGER(w2f__i4) NCENOTNC
PARAMETER ( NCENOTNC = -51)
INTEGER(w2f__i4) NCENOTVR
PARAMETER ( NCENOTVR = -49)
INTEGER(w2f__i4) NCENTOOL
PARAMETER ( NCENTOOL = -53)
INTEGER(w2f__i4) NCEPERM
PARAMETER ( NCEPERM = -37)
INTEGER(w2f__i4) NCESTS
PARAMETER ( NCESTS = -52)
INTEGER(w2f__i4) NCEUNLIM
PARAMETER ( NCEUNLIM = -47)
INTEGER(w2f__i4) NCEXCL
PARAMETER ( NCEXCL = 4)
INTEGER(w2f__i4) NCFATAL
PARAMETER ( NCFATAL = 1)
INTEGER(w2f__i4) NCFILL
PARAMETER ( NCFILL = 0)
INTEGER(w2f__i4) NCFLOAT
PARAMETER ( NCFLOAT = 5)
INTEGER(w2f__i4) NCFOOBAR
PARAMETER ( NCFOOBAR = 32)
INTEGER(w2f__i4) NCGLOBAL
PARAMETER ( NCGLOBAL = 0)
INTEGER(w2f__i4) NCHDIRTY
PARAMETER ( NCHDIRTY = 128)
INTEGER(w2f__i4) NCHSYNC
PARAMETER ( NCHSYNC = 32)
INTEGER(w2f__i4) NCINDEF
PARAMETER ( NCINDEF = 8)
INTEGER(w2f__i4) NCLINK
PARAMETER ( NCLINK = 32768)
INTEGER(w2f__i4) NCLONG
PARAMETER ( NCLONG = 4)
INTEGER(w2f__i4) NCNDIRTY
PARAMETER ( NCNDIRTY = 64)
INTEGER(w2f__i4) NCNOCLOB
PARAMETER ( NCNOCLOB = 4)
INTEGER(w2f__i4) NCNOERR
PARAMETER ( NCNOERR = 0)
INTEGER(w2f__i4) NCNOFILL
PARAMETER ( NCNOFILL = 256)
INTEGER(w2f__i4) NCNOWRIT
PARAMETER ( NCNOWRIT = 0)
INTEGER(w2f__i4) NCNSYNC
PARAMETER ( NCNSYNC = 16)
INTEGER(w2f__i4) NCRDWR
PARAMETER ( NCRDWR = 1)
INTEGER(w2f__i4) NCSHORT
PARAMETER ( NCSHORT = 3)
INTEGER(w2f__i4) NCSYSERR
PARAMETER ( NCSYSERR = -31)
INTEGER(w2f__i4) NCUNLIM
PARAMETER ( NCUNLIM = 0)
INTEGER(w2f__i4) NCVERBOS
PARAMETER ( NCVERBOS = 2)
INTEGER(w2f__i4) NCWRITE
PARAMETER ( NCWRITE = 1)
INTEGER(w2f__i4) NF_ALIGN_CHUNK
PARAMETER ( NF_ALIGN_CHUNK = -1)
INTEGER(w2f__i4) NF_BYTE
PARAMETER ( NF_BYTE = 1)
INTEGER(w2f__i4) NF_CHAR
PARAMETER ( NF_CHAR = 2)
INTEGER(w2f__i4) NF_CLOBBER
PARAMETER ( NF_CLOBBER = 0)
EXTERNAL nf_close
INTEGER(w2f__i4) nf_close
EXTERNAL nf_create
INTEGER(w2f__i4) nf_create
EXTERNAL nf_def_dim
INTEGER(w2f__i4) nf_def_dim
INTEGER(w2f__i4) NF_DOUBLE
PARAMETER ( NF_DOUBLE = 6)
INTEGER(w2f__i4) NF_EBADDIM
PARAMETER ( NF_EBADDIM = -46)
INTEGER(w2f__i4) NF_EBADID
PARAMETER ( NF_EBADID = -33)
INTEGER(w2f__i4) NF_EBADNAME
PARAMETER ( NF_EBADNAME = -59)
INTEGER(w2f__i4) NF_EBADTYPE
PARAMETER ( NF_EBADTYPE = -45)
INTEGER(w2f__i4) NF_ECHAR
PARAMETER ( NF_ECHAR = -56)
INTEGER(w2f__i4) NF_EEDGE
PARAMETER ( NF_EEDGE = -57)
INTEGER(w2f__i4) NF_EEXIST
PARAMETER ( NF_EEXIST = -35)
INTEGER(w2f__i4) NF_EGLOBAL
PARAMETER ( NF_EGLOBAL = -50)
INTEGER(w2f__i4) NF_EINDEFINE
PARAMETER ( NF_EINDEFINE = -39)
INTEGER(w2f__i4) NF_EINVAL
PARAMETER ( NF_EINVAL = -36)
INTEGER(w2f__i4) NF_EINVALCOORDS
PARAMETER ( NF_EINVALCOORDS = -40)
INTEGER(w2f__i4) NF_EMAXATTS
PARAMETER ( NF_EMAXATTS = -44)
INTEGER(w2f__i4) NF_EMAXDIMS
PARAMETER ( NF_EMAXDIMS = -41)
INTEGER(w2f__i4) NF_EMAXNAME
PARAMETER ( NF_EMAXNAME = -53)
INTEGER(w2f__i4) NF_EMAXVARS
PARAMETER ( NF_EMAXVARS = -48)
INTEGER(w2f__i4) NF_ENAMEINUSE
PARAMETER ( NF_ENAMEINUSE = -42)
EXTERNAL nf_enddef
INTEGER(w2f__i4) nf_enddef
INTEGER(w2f__i4) NF_ENOMEM
PARAMETER ( NF_ENOMEM = -61)
INTEGER(w2f__i4) NF_ENORECVARS
PARAMETER ( NF_ENORECVARS = -55)
INTEGER(w2f__i4) NF_ENOTATT
PARAMETER ( NF_ENOTATT = -43)
INTEGER(w2f__i4) NF_ENOTINDEFINE
PARAMETER ( NF_ENOTINDEFINE = -38)
INTEGER(w2f__i4) NF_ENOTNC
PARAMETER ( NF_ENOTNC = -51)
INTEGER(w2f__i4) NF_ENOTVAR
PARAMETER ( NF_ENOTVAR = -49)
INTEGER(w2f__i4) NF_EPERM
PARAMETER ( NF_EPERM = -37)
INTEGER(w2f__i4) NF_ERANGE
PARAMETER ( NF_ERANGE = -60)
INTEGER(w2f__i4) NF_ESTRIDE
PARAMETER ( NF_ESTRIDE = -58)
INTEGER(w2f__i4) NF_ESTS
PARAMETER ( NF_ESTS = -52)
INTEGER(w2f__i4) NF_EUNLIMIT
PARAMETER ( NF_EUNLIMIT = -54)
INTEGER(w2f__i4) NF_EUNLIMPOS
PARAMETER ( NF_EUNLIMPOS = -47)
INTEGER(w2f__i4) NF_FATAL
PARAMETER ( NF_FATAL = 1)
INTEGER(w2f__i4) NF_FILL
PARAMETER ( NF_FILL = 0)
INTEGER(w2f__i4) NF_FILL_BYTE
PARAMETER ( NF_FILL_BYTE = -127)
INTEGER(w2f__i4) NF_FILL_CHAR
PARAMETER ( NF_FILL_CHAR = 0)
REAL(w2f__8) NF_FILL_DOUBLE
PARAMETER ( NF_FILL_DOUBLE = 9.969209968386869d+36)
REAL(w2f__4) NF_FILL_FLOAT
PARAMETER ( NF_FILL_FLOAT = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_INT
PARAMETER ( NF_FILL_INT = -2147483647)
INTEGER(w2f__i4) NF_FILL_INT1
PARAMETER ( NF_FILL_INT1 = -127)
INTEGER(w2f__i4) NF_FILL_INT2
PARAMETER ( NF_FILL_INT2 = -32767)
REAL(w2f__4) NF_FILL_REAL
PARAMETER ( NF_FILL_REAL = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_SHORT
PARAMETER ( NF_FILL_SHORT = -32767)
INTEGER(w2f__i4) NF_FLOAT
PARAMETER ( NF_FLOAT = 5)
INTEGER(w2f__i4) NF_GLOBAL
PARAMETER ( NF_GLOBAL = 0)
INTEGER(w2f__i4) NF_INT
PARAMETER ( NF_INT = 4)
INTEGER(w2f__i4) NF_INT1
PARAMETER ( NF_INT1 = 1)
INTEGER(w2f__i4) NF_INT2
PARAMETER ( NF_INT2 = 3)
INTEGER(w2f__i4) NF_LOCK
PARAMETER ( NF_LOCK = 1024)
INTEGER(w2f__i4) NF_MAX_ATTRS
PARAMETER ( NF_MAX_ATTRS = 4096)
INTEGER(w2f__i4) NF_MAX_DIMS
PARAMETER ( NF_MAX_DIMS = 512)
INTEGER(w2f__i4) NF_MAX_NAME
PARAMETER ( NF_MAX_NAME = 128)
INTEGER(w2f__i4) NF_MAX_VARS
PARAMETER ( NF_MAX_VARS = 4096)
INTEGER(w2f__i4) NF_MAX_VAR_DIMS
PARAMETER ( NF_MAX_VAR_DIMS = 512)
INTEGER(w2f__i4) NF_NOCLOBBER
PARAMETER ( NF_NOCLOBBER = 4)
INTEGER(w2f__i4) NF_NOERR
PARAMETER ( NF_NOERR = 0)
INTEGER(w2f__i4) NF_NOFILL
PARAMETER ( NF_NOFILL = 256)
INTEGER(w2f__i4) NF_NOWRITE
PARAMETER ( NF_NOWRITE = 0)
EXTERNAL nf_put_att_text
INTEGER(w2f__i4) nf_put_att_text
INTEGER(w2f__i4) NF_REAL
PARAMETER ( NF_REAL = 5)
INTEGER(w2f__i4) NF_SHARE
PARAMETER ( NF_SHARE = 2048)
INTEGER(w2f__i4) NF_SHORT
PARAMETER ( NF_SHORT = 3)
INTEGER(w2f__i4) NF_SIZEHINT_DEFAULT
PARAMETER ( NF_SIZEHINT_DEFAULT = 0)
INTEGER(w2f__i4) NF_UNLIMITED
PARAMETER ( NF_UNLIMITED = 0)
INTEGER(w2f__i4) NF_VERBOSE
PARAMETER ( NF_VERBOSE = 2)
INTEGER(w2f__i4) NF_WRITE
PARAMETER ( NF_WRITE = 1)
CHARACTER(80) STR1
CHARACTER(80) STR2
C
C **** statements ****
C
ERRMSG = nf_create(FNAME, (0), FID)
STR1 = 'nf_create'
CALL handle_err(ERRMSG, STR1)
LCHAR = lastchar(TNAME)
STR1 = 'title'
ERRMSG = nf_put_att_text(FID, (0), STR1, LCHAR, TNAME(1_w2f__i8 :
> MAX(LCHAR, 0)))
STR1 = 'nf_put_att_text: title'
CALL handle_err(ERRMSG, STR1)
STR1 = 'TIME'
STR2 = 'nf_def_dim: TIME'
ERRMSG = nf_def_dim(FID, STR1, (0), DID)
CALL handle_err(ERRMSG, STR2)
STR1 = 'X'
STR2 = 'nf_def_dim: X'
ERRMSG = nf_def_dim(FID, STR1, NX, DID)
CALL handle_err(ERRMSG, STR2)
STR1 = 'Y'
STR2 = 'nf_def_dim: Y'
ERRMSG = nf_def_dim(FID, STR1, NY, DID)
CALL handle_err(ERRMSG, STR2)
STR1 = 'nf_enddef'
ERRMSG = nf_enddef(FID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_close'
ERRMSG = nf_close(FID)
CALL handle_err(ERRMSG, STR1)
RETURN
END SUBROUTINE
SUBROUTINE add_gatta_netcdf(FNAME, ANAME, A)
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Parameters and Result ****
C
CHARACTER(80) FNAME
CHARACTER(80) ANAME
CHARACTER(80) A
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) ERRMSG
INTEGER(w2f__i4) FID
INTEGER(w2f__i4) FILBYTE
PARAMETER ( FILBYTE = -127)
INTEGER(w2f__i4) FILCHAR
PARAMETER ( FILCHAR = 0)
REAL(w2f__8) FILDOUB
PARAMETER ( FILDOUB = 9.969209968386869d+36)
REAL(w2f__4) FILFLOAT
PARAMETER ( FILFLOAT = 9.969210d+36)
INTEGER(w2f__i4) FILLONG
PARAMETER ( FILLONG = -2147483647)
INTEGER(w2f__i4) FILSHORT
PARAMETER ( FILSHORT = -32767)
EXTERNAL handle_err
EXTERNAL lastchar
INTEGER(w2f__i4) lastchar
INTEGER(w2f__i4) LCHAR
INTEGER(w2f__i4) MAXNCATT
PARAMETER ( MAXNCATT = 2000)
INTEGER(w2f__i4) MAXNCDIM
PARAMETER ( MAXNCDIM = 100)
INTEGER(w2f__i4) MAXNCNAM
PARAMETER ( MAXNCNAM = 128)
INTEGER(w2f__i4) MAXNCOP
PARAMETER ( MAXNCOP = 32)
INTEGER(w2f__i4) MAXNCVAR
PARAMETER ( MAXNCVAR = 2000)
INTEGER(w2f__i4) MAXVDIMS
PARAMETER ( MAXVDIMS = 100)
INTEGER(w2f__i4) NCBYTE
PARAMETER ( NCBYTE = 1)
INTEGER(w2f__i4) NCCHAR
PARAMETER ( NCCHAR = 2)
INTEGER(w2f__i4) NCCLOB
PARAMETER ( NCCLOB = 0)
INTEGER(w2f__i4) NCCREAT
PARAMETER ( NCCREAT = 2)
INTEGER(w2f__i4) NCDOUBLE
PARAMETER ( NCDOUBLE = 6)
INTEGER(w2f__i4) NCEBADD
PARAMETER ( NCEBADD = -46)
INTEGER(w2f__i4) NCEBADID
PARAMETER ( NCEBADID = -33)
INTEGER(w2f__i4) NCEBADTY
PARAMETER ( NCEBADTY = -45)
INTEGER(w2f__i4) NCECOORD
PARAMETER ( NCECOORD = -40)
INTEGER(w2f__i4) NCEEXIST
PARAMETER ( NCEEXIST = -35)
INTEGER(w2f__i4) NCEGLOB
PARAMETER ( NCEGLOB = -50)
INTEGER(w2f__i4) NCEINDEF
PARAMETER ( NCEINDEF = -39)
INTEGER(w2f__i4) NCEINVAL
PARAMETER ( NCEINVAL = -36)
INTEGER(w2f__i4) NCEMAXAT
PARAMETER ( NCEMAXAT = -44)
INTEGER(w2f__i4) NCEMAXDS
PARAMETER ( NCEMAXDS = -41)
INTEGER(w2f__i4) NCEMAXVS
PARAMETER ( NCEMAXVS = -48)
INTEGER(w2f__i4) NCENAME
PARAMETER ( NCENAME = -42)
INTEGER(w2f__i4) NCENFILE
PARAMETER ( NCENFILE = -31)
INTEGER(w2f__i4) NCENOATT
PARAMETER ( NCENOATT = -43)
INTEGER(w2f__i4) NCENOTIN
PARAMETER ( NCENOTIN = -38)
INTEGER(w2f__i4) NCENOTNC
PARAMETER ( NCENOTNC = -51)
INTEGER(w2f__i4) NCENOTVR
PARAMETER ( NCENOTVR = -49)
INTEGER(w2f__i4) NCENTOOL
PARAMETER ( NCENTOOL = -53)
INTEGER(w2f__i4) NCEPERM
PARAMETER ( NCEPERM = -37)
INTEGER(w2f__i4) NCESTS
PARAMETER ( NCESTS = -52)
INTEGER(w2f__i4) NCEUNLIM
PARAMETER ( NCEUNLIM = -47)
INTEGER(w2f__i4) NCEXCL
PARAMETER ( NCEXCL = 4)
INTEGER(w2f__i4) NCFATAL
PARAMETER ( NCFATAL = 1)
INTEGER(w2f__i4) NCFILL
PARAMETER ( NCFILL = 0)
INTEGER(w2f__i4) NCFLOAT
PARAMETER ( NCFLOAT = 5)
INTEGER(w2f__i4) NCFOOBAR
PARAMETER ( NCFOOBAR = 32)
INTEGER(w2f__i4) NCGLOBAL
PARAMETER ( NCGLOBAL = 0)
INTEGER(w2f__i4) NCHDIRTY
PARAMETER ( NCHDIRTY = 128)
INTEGER(w2f__i4) NCHSYNC
PARAMETER ( NCHSYNC = 32)
INTEGER(w2f__i4) NCINDEF
PARAMETER ( NCINDEF = 8)
INTEGER(w2f__i4) NCLINK
PARAMETER ( NCLINK = 32768)
INTEGER(w2f__i4) NCLONG
PARAMETER ( NCLONG = 4)
INTEGER(w2f__i4) NCNDIRTY
PARAMETER ( NCNDIRTY = 64)
INTEGER(w2f__i4) NCNOCLOB
PARAMETER ( NCNOCLOB = 4)
INTEGER(w2f__i4) NCNOERR
PARAMETER ( NCNOERR = 0)
INTEGER(w2f__i4) NCNOFILL
PARAMETER ( NCNOFILL = 256)
INTEGER(w2f__i4) NCNOWRIT
PARAMETER ( NCNOWRIT = 0)
INTEGER(w2f__i4) NCNSYNC
PARAMETER ( NCNSYNC = 16)
INTEGER(w2f__i4) NCRDWR
PARAMETER ( NCRDWR = 1)
INTEGER(w2f__i4) NCSHORT
PARAMETER ( NCSHORT = 3)
INTEGER(w2f__i4) NCSYSERR
PARAMETER ( NCSYSERR = -31)
INTEGER(w2f__i4) NCUNLIM
PARAMETER ( NCUNLIM = 0)
INTEGER(w2f__i4) NCVERBOS
PARAMETER ( NCVERBOS = 2)
INTEGER(w2f__i4) NCWRITE
PARAMETER ( NCWRITE = 1)
INTEGER(w2f__i4) NF_ALIGN_CHUNK
PARAMETER ( NF_ALIGN_CHUNK = -1)
INTEGER(w2f__i4) NF_BYTE
PARAMETER ( NF_BYTE = 1)
INTEGER(w2f__i4) NF_CHAR
PARAMETER ( NF_CHAR = 2)
INTEGER(w2f__i4) NF_CLOBBER
PARAMETER ( NF_CLOBBER = 0)
EXTERNAL nf_close
INTEGER(w2f__i4) nf_close
INTEGER(w2f__i4) NF_DOUBLE
PARAMETER ( NF_DOUBLE = 6)
INTEGER(w2f__i4) NF_EBADDIM
PARAMETER ( NF_EBADDIM = -46)
INTEGER(w2f__i4) NF_EBADID
PARAMETER ( NF_EBADID = -33)
INTEGER(w2f__i4) NF_EBADNAME
PARAMETER ( NF_EBADNAME = -59)
INTEGER(w2f__i4) NF_EBADTYPE
PARAMETER ( NF_EBADTYPE = -45)
INTEGER(w2f__i4) NF_ECHAR
PARAMETER ( NF_ECHAR = -56)
INTEGER(w2f__i4) NF_EEDGE
PARAMETER ( NF_EEDGE = -57)
INTEGER(w2f__i4) NF_EEXIST
PARAMETER ( NF_EEXIST = -35)
INTEGER(w2f__i4) NF_EGLOBAL
PARAMETER ( NF_EGLOBAL = -50)
INTEGER(w2f__i4) NF_EINDEFINE
PARAMETER ( NF_EINDEFINE = -39)
INTEGER(w2f__i4) NF_EINVAL
PARAMETER ( NF_EINVAL = -36)
INTEGER(w2f__i4) NF_EINVALCOORDS
PARAMETER ( NF_EINVALCOORDS = -40)
INTEGER(w2f__i4) NF_EMAXATTS
PARAMETER ( NF_EMAXATTS = -44)
INTEGER(w2f__i4) NF_EMAXDIMS
PARAMETER ( NF_EMAXDIMS = -41)
INTEGER(w2f__i4) NF_EMAXNAME
PARAMETER ( NF_EMAXNAME = -53)
INTEGER(w2f__i4) NF_EMAXVARS
PARAMETER ( NF_EMAXVARS = -48)
INTEGER(w2f__i4) NF_ENAMEINUSE
PARAMETER ( NF_ENAMEINUSE = -42)
INTEGER(w2f__i4) NF_ENOMEM
PARAMETER ( NF_ENOMEM = -61)
INTEGER(w2f__i4) NF_ENORECVARS
PARAMETER ( NF_ENORECVARS = -55)
INTEGER(w2f__i4) NF_ENOTATT
PARAMETER ( NF_ENOTATT = -43)
INTEGER(w2f__i4) NF_ENOTINDEFINE
PARAMETER ( NF_ENOTINDEFINE = -38)
INTEGER(w2f__i4) NF_ENOTNC
PARAMETER ( NF_ENOTNC = -51)
INTEGER(w2f__i4) NF_ENOTVAR
PARAMETER ( NF_ENOTVAR = -49)
INTEGER(w2f__i4) NF_EPERM
PARAMETER ( NF_EPERM = -37)
INTEGER(w2f__i4) NF_ERANGE
PARAMETER ( NF_ERANGE = -60)
INTEGER(w2f__i4) NF_ESTRIDE
PARAMETER ( NF_ESTRIDE = -58)
INTEGER(w2f__i4) NF_ESTS
PARAMETER ( NF_ESTS = -52)
INTEGER(w2f__i4) NF_EUNLIMIT
PARAMETER ( NF_EUNLIMIT = -54)
INTEGER(w2f__i4) NF_EUNLIMPOS
PARAMETER ( NF_EUNLIMPOS = -47)
INTEGER(w2f__i4) NF_FATAL
PARAMETER ( NF_FATAL = 1)
INTEGER(w2f__i4) NF_FILL
PARAMETER ( NF_FILL = 0)
INTEGER(w2f__i4) NF_FILL_BYTE
PARAMETER ( NF_FILL_BYTE = -127)
INTEGER(w2f__i4) NF_FILL_CHAR
PARAMETER ( NF_FILL_CHAR = 0)
REAL(w2f__8) NF_FILL_DOUBLE
PARAMETER ( NF_FILL_DOUBLE = 9.969209968386869d+36)
REAL(w2f__4) NF_FILL_FLOAT
PARAMETER ( NF_FILL_FLOAT = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_INT
PARAMETER ( NF_FILL_INT = -2147483647)
INTEGER(w2f__i4) NF_FILL_INT1
PARAMETER ( NF_FILL_INT1 = -127)
INTEGER(w2f__i4) NF_FILL_INT2
PARAMETER ( NF_FILL_INT2 = -32767)
REAL(w2f__4) NF_FILL_REAL
PARAMETER ( NF_FILL_REAL = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_SHORT
PARAMETER ( NF_FILL_SHORT = -32767)
INTEGER(w2f__i4) NF_FLOAT
PARAMETER ( NF_FLOAT = 5)
INTEGER(w2f__i4) NF_GLOBAL
PARAMETER ( NF_GLOBAL = 0)
INTEGER(w2f__i4) NF_INT
PARAMETER ( NF_INT = 4)
INTEGER(w2f__i4) NF_INT1
PARAMETER ( NF_INT1 = 1)
INTEGER(w2f__i4) NF_INT2
PARAMETER ( NF_INT2 = 3)
INTEGER(w2f__i4) NF_LOCK
PARAMETER ( NF_LOCK = 1024)
INTEGER(w2f__i4) NF_MAX_ATTRS
PARAMETER ( NF_MAX_ATTRS = 4096)
INTEGER(w2f__i4) NF_MAX_DIMS
PARAMETER ( NF_MAX_DIMS = 512)
INTEGER(w2f__i4) NF_MAX_NAME
PARAMETER ( NF_MAX_NAME = 128)
INTEGER(w2f__i4) NF_MAX_VARS
PARAMETER ( NF_MAX_VARS = 4096)
INTEGER(w2f__i4) NF_MAX_VAR_DIMS
PARAMETER ( NF_MAX_VAR_DIMS = 512)
INTEGER(w2f__i4) NF_NOCLOBBER
PARAMETER ( NF_NOCLOBBER = 4)
INTEGER(w2f__i4) NF_NOERR
PARAMETER ( NF_NOERR = 0)
INTEGER(w2f__i4) NF_NOFILL
PARAMETER ( NF_NOFILL = 256)
INTEGER(w2f__i4) NF_NOWRITE
PARAMETER ( NF_NOWRITE = 0)
EXTERNAL nf_open
INTEGER(w2f__i4) nf_open
EXTERNAL nf_put_att_text
INTEGER(w2f__i4) nf_put_att_text
INTEGER(w2f__i4) NF_REAL
PARAMETER ( NF_REAL = 5)
EXTERNAL nf_redef
INTEGER(w2f__i4) nf_redef
INTEGER(w2f__i4) NF_SHARE
PARAMETER ( NF_SHARE = 2048)
INTEGER(w2f__i4) NF_SHORT
PARAMETER ( NF_SHORT = 3)
INTEGER(w2f__i4) NF_SIZEHINT_DEFAULT
PARAMETER ( NF_SIZEHINT_DEFAULT = 0)
INTEGER(w2f__i4) NF_UNLIMITED
PARAMETER ( NF_UNLIMITED = 0)
INTEGER(w2f__i4) NF_VERBOSE
PARAMETER ( NF_VERBOSE = 2)
INTEGER(w2f__i4) NF_WRITE
PARAMETER ( NF_WRITE = 1)
CHARACTER(80) STR1
C
C **** statements ****
C
STR1 = 'nf_open'
ERRMSG = nf_open(FNAME, (1), FID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_redef'
ERRMSG = nf_redef(FID)
CALL handle_err(ERRMSG, STR1)
LCHAR = lastchar(A)
IF(LCHAR .eq. INT(0_w2f__i8)) THEN
LCHAR = 1
ENDIF
STR1 = 'nf_put_att_text: ' // ANAME
ERRMSG = nf_put_att_text(FID, (0), ANAME, LCHAR, A(1_w2f__i8 :
> MAX(LCHAR, 0)))
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_close'
ERRMSG = nf_close(FID)
CALL handle_err(ERRMSG, STR1)
RETURN
END SUBROUTINE
SUBROUTINE add_gatti_netcdf(FNAME, ANAME, A)
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Parameters and Result ****
C
CHARACTER(80) FNAME
CHARACTER(80) ANAME
INTEGER(w2f__i4) A
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) ERRMSG
INTEGER(w2f__i4) FID
INTEGER(w2f__i4) FILBYTE
PARAMETER ( FILBYTE = -127)
INTEGER(w2f__i4) FILCHAR
PARAMETER ( FILCHAR = 0)
REAL(w2f__8) FILDOUB
PARAMETER ( FILDOUB = 9.969209968386869d+36)
REAL(w2f__4) FILFLOAT
PARAMETER ( FILFLOAT = 9.969210d+36)
INTEGER(w2f__i4) FILLONG
PARAMETER ( FILLONG = -2147483647)
INTEGER(w2f__i4) FILSHORT
PARAMETER ( FILSHORT = -32767)
EXTERNAL handle_err
INTEGER(w2f__i4) MAXNCATT
PARAMETER ( MAXNCATT = 2000)
INTEGER(w2f__i4) MAXNCDIM
PARAMETER ( MAXNCDIM = 100)
INTEGER(w2f__i4) MAXNCNAM
PARAMETER ( MAXNCNAM = 128)
INTEGER(w2f__i4) MAXNCOP
PARAMETER ( MAXNCOP = 32)
INTEGER(w2f__i4) MAXNCVAR
PARAMETER ( MAXNCVAR = 2000)
INTEGER(w2f__i4) MAXVDIMS
PARAMETER ( MAXVDIMS = 100)
INTEGER(w2f__i4) NCBYTE
PARAMETER ( NCBYTE = 1)
INTEGER(w2f__i4) NCCHAR
PARAMETER ( NCCHAR = 2)
INTEGER(w2f__i4) NCCLOB
PARAMETER ( NCCLOB = 0)
INTEGER(w2f__i4) NCCREAT
PARAMETER ( NCCREAT = 2)
INTEGER(w2f__i4) NCDOUBLE
PARAMETER ( NCDOUBLE = 6)
INTEGER(w2f__i4) NCEBADD
PARAMETER ( NCEBADD = -46)
INTEGER(w2f__i4) NCEBADID
PARAMETER ( NCEBADID = -33)
INTEGER(w2f__i4) NCEBADTY
PARAMETER ( NCEBADTY = -45)
INTEGER(w2f__i4) NCECOORD
PARAMETER ( NCECOORD = -40)
INTEGER(w2f__i4) NCEEXIST
PARAMETER ( NCEEXIST = -35)
INTEGER(w2f__i4) NCEGLOB
PARAMETER ( NCEGLOB = -50)
INTEGER(w2f__i4) NCEINDEF
PARAMETER ( NCEINDEF = -39)
INTEGER(w2f__i4) NCEINVAL
PARAMETER ( NCEINVAL = -36)
INTEGER(w2f__i4) NCEMAXAT
PARAMETER ( NCEMAXAT = -44)
INTEGER(w2f__i4) NCEMAXDS
PARAMETER ( NCEMAXDS = -41)
INTEGER(w2f__i4) NCEMAXVS
PARAMETER ( NCEMAXVS = -48)
INTEGER(w2f__i4) NCENAME
PARAMETER ( NCENAME = -42)
INTEGER(w2f__i4) NCENFILE
PARAMETER ( NCENFILE = -31)
INTEGER(w2f__i4) NCENOATT
PARAMETER ( NCENOATT = -43)
INTEGER(w2f__i4) NCENOTIN
PARAMETER ( NCENOTIN = -38)
INTEGER(w2f__i4) NCENOTNC
PARAMETER ( NCENOTNC = -51)
INTEGER(w2f__i4) NCENOTVR
PARAMETER ( NCENOTVR = -49)
INTEGER(w2f__i4) NCENTOOL
PARAMETER ( NCENTOOL = -53)
INTEGER(w2f__i4) NCEPERM
PARAMETER ( NCEPERM = -37)
INTEGER(w2f__i4) NCESTS
PARAMETER ( NCESTS = -52)
INTEGER(w2f__i4) NCEUNLIM
PARAMETER ( NCEUNLIM = -47)
INTEGER(w2f__i4) NCEXCL
PARAMETER ( NCEXCL = 4)
INTEGER(w2f__i4) NCFATAL
PARAMETER ( NCFATAL = 1)
INTEGER(w2f__i4) NCFILL
PARAMETER ( NCFILL = 0)
INTEGER(w2f__i4) NCFLOAT
PARAMETER ( NCFLOAT = 5)
INTEGER(w2f__i4) NCFOOBAR
PARAMETER ( NCFOOBAR = 32)
INTEGER(w2f__i4) NCGLOBAL
PARAMETER ( NCGLOBAL = 0)
INTEGER(w2f__i4) NCHDIRTY
PARAMETER ( NCHDIRTY = 128)
INTEGER(w2f__i4) NCHSYNC
PARAMETER ( NCHSYNC = 32)
INTEGER(w2f__i4) NCINDEF
PARAMETER ( NCINDEF = 8)
INTEGER(w2f__i4) NCLINK
PARAMETER ( NCLINK = 32768)
INTEGER(w2f__i4) NCLONG
PARAMETER ( NCLONG = 4)
INTEGER(w2f__i4) NCNDIRTY
PARAMETER ( NCNDIRTY = 64)
INTEGER(w2f__i4) NCNOCLOB
PARAMETER ( NCNOCLOB = 4)
INTEGER(w2f__i4) NCNOERR
PARAMETER ( NCNOERR = 0)
INTEGER(w2f__i4) NCNOFILL
PARAMETER ( NCNOFILL = 256)
INTEGER(w2f__i4) NCNOWRIT
PARAMETER ( NCNOWRIT = 0)
INTEGER(w2f__i4) NCNSYNC
PARAMETER ( NCNSYNC = 16)
INTEGER(w2f__i4) NCRDWR
PARAMETER ( NCRDWR = 1)
INTEGER(w2f__i4) NCSHORT
PARAMETER ( NCSHORT = 3)
INTEGER(w2f__i4) NCSYSERR
PARAMETER ( NCSYSERR = -31)
INTEGER(w2f__i4) NCUNLIM
PARAMETER ( NCUNLIM = 0)
INTEGER(w2f__i4) NCVERBOS
PARAMETER ( NCVERBOS = 2)
INTEGER(w2f__i4) NCWRITE
PARAMETER ( NCWRITE = 1)
INTEGER(w2f__i4) NF_ALIGN_CHUNK
PARAMETER ( NF_ALIGN_CHUNK = -1)
INTEGER(w2f__i4) NF_BYTE
PARAMETER ( NF_BYTE = 1)
INTEGER(w2f__i4) NF_CHAR
PARAMETER ( NF_CHAR = 2)
INTEGER(w2f__i4) NF_CLOBBER
PARAMETER ( NF_CLOBBER = 0)
EXTERNAL nf_close
INTEGER(w2f__i4) nf_close
INTEGER(w2f__i4) NF_DOUBLE
PARAMETER ( NF_DOUBLE = 6)
INTEGER(w2f__i4) NF_EBADDIM
PARAMETER ( NF_EBADDIM = -46)
INTEGER(w2f__i4) NF_EBADID
PARAMETER ( NF_EBADID = -33)
INTEGER(w2f__i4) NF_EBADNAME
PARAMETER ( NF_EBADNAME = -59)
INTEGER(w2f__i4) NF_EBADTYPE
PARAMETER ( NF_EBADTYPE = -45)
INTEGER(w2f__i4) NF_ECHAR
PARAMETER ( NF_ECHAR = -56)
INTEGER(w2f__i4) NF_EEDGE
PARAMETER ( NF_EEDGE = -57)
INTEGER(w2f__i4) NF_EEXIST
PARAMETER ( NF_EEXIST = -35)
INTEGER(w2f__i4) NF_EGLOBAL
PARAMETER ( NF_EGLOBAL = -50)
INTEGER(w2f__i4) NF_EINDEFINE
PARAMETER ( NF_EINDEFINE = -39)
INTEGER(w2f__i4) NF_EINVAL
PARAMETER ( NF_EINVAL = -36)
INTEGER(w2f__i4) NF_EINVALCOORDS
PARAMETER ( NF_EINVALCOORDS = -40)
INTEGER(w2f__i4) NF_EMAXATTS
PARAMETER ( NF_EMAXATTS = -44)
INTEGER(w2f__i4) NF_EMAXDIMS
PARAMETER ( NF_EMAXDIMS = -41)
INTEGER(w2f__i4) NF_EMAXNAME
PARAMETER ( NF_EMAXNAME = -53)
INTEGER(w2f__i4) NF_EMAXVARS
PARAMETER ( NF_EMAXVARS = -48)
INTEGER(w2f__i4) NF_ENAMEINUSE
PARAMETER ( NF_ENAMEINUSE = -42)
INTEGER(w2f__i4) NF_ENOMEM
PARAMETER ( NF_ENOMEM = -61)
INTEGER(w2f__i4) NF_ENORECVARS
PARAMETER ( NF_ENORECVARS = -55)
INTEGER(w2f__i4) NF_ENOTATT
PARAMETER ( NF_ENOTATT = -43)
INTEGER(w2f__i4) NF_ENOTINDEFINE
PARAMETER ( NF_ENOTINDEFINE = -38)
INTEGER(w2f__i4) NF_ENOTNC
PARAMETER ( NF_ENOTNC = -51)
INTEGER(w2f__i4) NF_ENOTVAR
PARAMETER ( NF_ENOTVAR = -49)
INTEGER(w2f__i4) NF_EPERM
PARAMETER ( NF_EPERM = -37)
INTEGER(w2f__i4) NF_ERANGE
PARAMETER ( NF_ERANGE = -60)
INTEGER(w2f__i4) NF_ESTRIDE
PARAMETER ( NF_ESTRIDE = -58)
INTEGER(w2f__i4) NF_ESTS
PARAMETER ( NF_ESTS = -52)
INTEGER(w2f__i4) NF_EUNLIMIT
PARAMETER ( NF_EUNLIMIT = -54)
INTEGER(w2f__i4) NF_EUNLIMPOS
PARAMETER ( NF_EUNLIMPOS = -47)
INTEGER(w2f__i4) NF_FATAL
PARAMETER ( NF_FATAL = 1)
INTEGER(w2f__i4) NF_FILL
PARAMETER ( NF_FILL = 0)
INTEGER(w2f__i4) NF_FILL_BYTE
PARAMETER ( NF_FILL_BYTE = -127)
INTEGER(w2f__i4) NF_FILL_CHAR
PARAMETER ( NF_FILL_CHAR = 0)
REAL(w2f__8) NF_FILL_DOUBLE
PARAMETER ( NF_FILL_DOUBLE = 9.969209968386869d+36)
REAL(w2f__4) NF_FILL_FLOAT
PARAMETER ( NF_FILL_FLOAT = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_INT
PARAMETER ( NF_FILL_INT = -2147483647)
INTEGER(w2f__i4) NF_FILL_INT1
PARAMETER ( NF_FILL_INT1 = -127)
INTEGER(w2f__i4) NF_FILL_INT2
PARAMETER ( NF_FILL_INT2 = -32767)
REAL(w2f__4) NF_FILL_REAL
PARAMETER ( NF_FILL_REAL = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_SHORT
PARAMETER ( NF_FILL_SHORT = -32767)
INTEGER(w2f__i4) NF_FLOAT
PARAMETER ( NF_FLOAT = 5)
INTEGER(w2f__i4) NF_GLOBAL
PARAMETER ( NF_GLOBAL = 0)
INTEGER(w2f__i4) NF_INT
PARAMETER ( NF_INT = 4)
INTEGER(w2f__i4) NF_INT1
PARAMETER ( NF_INT1 = 1)
INTEGER(w2f__i4) NF_INT2
PARAMETER ( NF_INT2 = 3)
INTEGER(w2f__i4) NF_LOCK
PARAMETER ( NF_LOCK = 1024)
INTEGER(w2f__i4) NF_MAX_ATTRS
PARAMETER ( NF_MAX_ATTRS = 4096)
INTEGER(w2f__i4) NF_MAX_DIMS
PARAMETER ( NF_MAX_DIMS = 512)
INTEGER(w2f__i4) NF_MAX_NAME
PARAMETER ( NF_MAX_NAME = 128)
INTEGER(w2f__i4) NF_MAX_VARS
PARAMETER ( NF_MAX_VARS = 4096)
INTEGER(w2f__i4) NF_MAX_VAR_DIMS
PARAMETER ( NF_MAX_VAR_DIMS = 512)
INTEGER(w2f__i4) NF_NOCLOBBER
PARAMETER ( NF_NOCLOBBER = 4)
INTEGER(w2f__i4) NF_NOERR
PARAMETER ( NF_NOERR = 0)
INTEGER(w2f__i4) NF_NOFILL
PARAMETER ( NF_NOFILL = 256)
INTEGER(w2f__i4) NF_NOWRITE
PARAMETER ( NF_NOWRITE = 0)
EXTERNAL nf_open
INTEGER(w2f__i4) nf_open
EXTERNAL nf_put_att_int
INTEGER(w2f__i4) nf_put_att_int
INTEGER(w2f__i4) NF_REAL
PARAMETER ( NF_REAL = 5)
EXTERNAL nf_redef
INTEGER(w2f__i4) nf_redef
INTEGER(w2f__i4) NF_SHARE
PARAMETER ( NF_SHARE = 2048)
INTEGER(w2f__i4) NF_SHORT
PARAMETER ( NF_SHORT = 3)
INTEGER(w2f__i4) NF_SIZEHINT_DEFAULT
PARAMETER ( NF_SIZEHINT_DEFAULT = 0)
INTEGER(w2f__i4) NF_UNLIMITED
PARAMETER ( NF_UNLIMITED = 0)
INTEGER(w2f__i4) NF_VERBOSE
PARAMETER ( NF_VERBOSE = 2)
INTEGER(w2f__i4) NF_WRITE
PARAMETER ( NF_WRITE = 1)
CHARACTER(80) STR1
C
C **** statements ****
C
STR1 = 'nf_open'
ERRMSG = nf_open(FNAME, (1), FID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_redef'
ERRMSG = nf_redef(FID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_put_att_int ' // ANAME
ERRMSG = nf_put_att_int(FID, (0), ANAME, (4), (1), A)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_close'
ERRMSG = nf_close(FID)
CALL handle_err(ERRMSG, STR1)
RETURN
END SUBROUTINE
SUBROUTINE add_gattr_netcdf(FNAME, ANAME, A)
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Parameters and Result ****
C
CHARACTER(80) FNAME
CHARACTER(80) ANAME
type(active) :: A
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i4) ERRMSG
INTEGER(w2f__i4) FID
INTEGER(w2f__i4) FILBYTE
PARAMETER ( FILBYTE = -127)
INTEGER(w2f__i4) FILCHAR
PARAMETER ( FILCHAR = 0)
REAL(w2f__8) FILDOUB
PARAMETER ( FILDOUB = 9.969209968386869d+36)
REAL(w2f__4) FILFLOAT
PARAMETER ( FILFLOAT = 9.969210d+36)
INTEGER(w2f__i4) FILLONG
PARAMETER ( FILLONG = -2147483647)
INTEGER(w2f__i4) FILSHORT
PARAMETER ( FILSHORT = -32767)
EXTERNAL handle_err
INTEGER(w2f__i4) MAXNCATT
PARAMETER ( MAXNCATT = 2000)
INTEGER(w2f__i4) MAXNCDIM
PARAMETER ( MAXNCDIM = 100)
INTEGER(w2f__i4) MAXNCNAM
PARAMETER ( MAXNCNAM = 128)
INTEGER(w2f__i4) MAXNCOP
PARAMETER ( MAXNCOP = 32)
INTEGER(w2f__i4) MAXNCVAR
PARAMETER ( MAXNCVAR = 2000)
INTEGER(w2f__i4) MAXVDIMS
PARAMETER ( MAXVDIMS = 100)
INTEGER(w2f__i4) NCBYTE
PARAMETER ( NCBYTE = 1)
INTEGER(w2f__i4) NCCHAR
PARAMETER ( NCCHAR = 2)
INTEGER(w2f__i4) NCCLOB
PARAMETER ( NCCLOB = 0)
INTEGER(w2f__i4) NCCREAT
PARAMETER ( NCCREAT = 2)
INTEGER(w2f__i4) NCDOUBLE
PARAMETER ( NCDOUBLE = 6)
INTEGER(w2f__i4) NCEBADD
PARAMETER ( NCEBADD = -46)
INTEGER(w2f__i4) NCEBADID
PARAMETER ( NCEBADID = -33)
INTEGER(w2f__i4) NCEBADTY
PARAMETER ( NCEBADTY = -45)
INTEGER(w2f__i4) NCECOORD
PARAMETER ( NCECOORD = -40)
INTEGER(w2f__i4) NCEEXIST
PARAMETER ( NCEEXIST = -35)
INTEGER(w2f__i4) NCEGLOB
PARAMETER ( NCEGLOB = -50)
INTEGER(w2f__i4) NCEINDEF
PARAMETER ( NCEINDEF = -39)
INTEGER(w2f__i4) NCEINVAL
PARAMETER ( NCEINVAL = -36)
INTEGER(w2f__i4) NCEMAXAT
PARAMETER ( NCEMAXAT = -44)
INTEGER(w2f__i4) NCEMAXDS
PARAMETER ( NCEMAXDS = -41)
INTEGER(w2f__i4) NCEMAXVS
PARAMETER ( NCEMAXVS = -48)
INTEGER(w2f__i4) NCENAME
PARAMETER ( NCENAME = -42)
INTEGER(w2f__i4) NCENFILE
PARAMETER ( NCENFILE = -31)
INTEGER(w2f__i4) NCENOATT
PARAMETER ( NCENOATT = -43)
INTEGER(w2f__i4) NCENOTIN
PARAMETER ( NCENOTIN = -38)
INTEGER(w2f__i4) NCENOTNC
PARAMETER ( NCENOTNC = -51)
INTEGER(w2f__i4) NCENOTVR
PARAMETER ( NCENOTVR = -49)
INTEGER(w2f__i4) NCENTOOL
PARAMETER ( NCENTOOL = -53)
INTEGER(w2f__i4) NCEPERM
PARAMETER ( NCEPERM = -37)
INTEGER(w2f__i4) NCESTS
PARAMETER ( NCESTS = -52)
INTEGER(w2f__i4) NCEUNLIM
PARAMETER ( NCEUNLIM = -47)
INTEGER(w2f__i4) NCEXCL
PARAMETER ( NCEXCL = 4)
INTEGER(w2f__i4) NCFATAL
PARAMETER ( NCFATAL = 1)
INTEGER(w2f__i4) NCFILL
PARAMETER ( NCFILL = 0)
INTEGER(w2f__i4) NCFLOAT
PARAMETER ( NCFLOAT = 5)
INTEGER(w2f__i4) NCFOOBAR
PARAMETER ( NCFOOBAR = 32)
INTEGER(w2f__i4) NCGLOBAL
PARAMETER ( NCGLOBAL = 0)
INTEGER(w2f__i4) NCHDIRTY
PARAMETER ( NCHDIRTY = 128)
INTEGER(w2f__i4) NCHSYNC
PARAMETER ( NCHSYNC = 32)
INTEGER(w2f__i4) NCINDEF
PARAMETER ( NCINDEF = 8)
INTEGER(w2f__i4) NCLINK
PARAMETER ( NCLINK = 32768)
INTEGER(w2f__i4) NCLONG
PARAMETER ( NCLONG = 4)
INTEGER(w2f__i4) NCNDIRTY
PARAMETER ( NCNDIRTY = 64)
INTEGER(w2f__i4) NCNOCLOB
PARAMETER ( NCNOCLOB = 4)
INTEGER(w2f__i4) NCNOERR
PARAMETER ( NCNOERR = 0)
INTEGER(w2f__i4) NCNOFILL
PARAMETER ( NCNOFILL = 256)
INTEGER(w2f__i4) NCNOWRIT
PARAMETER ( NCNOWRIT = 0)
INTEGER(w2f__i4) NCNSYNC
PARAMETER ( NCNSYNC = 16)
INTEGER(w2f__i4) NCRDWR
PARAMETER ( NCRDWR = 1)
INTEGER(w2f__i4) NCSHORT
PARAMETER ( NCSHORT = 3)
INTEGER(w2f__i4) NCSYSERR
PARAMETER ( NCSYSERR = -31)
INTEGER(w2f__i4) NCUNLIM
PARAMETER ( NCUNLIM = 0)
INTEGER(w2f__i4) NCVERBOS
PARAMETER ( NCVERBOS = 2)
INTEGER(w2f__i4) NCWRITE
PARAMETER ( NCWRITE = 1)
INTEGER(w2f__i4) NF_ALIGN_CHUNK
PARAMETER ( NF_ALIGN_CHUNK = -1)
INTEGER(w2f__i4) NF_BYTE
PARAMETER ( NF_BYTE = 1)
INTEGER(w2f__i4) NF_CHAR
PARAMETER ( NF_CHAR = 2)
INTEGER(w2f__i4) NF_CLOBBER
PARAMETER ( NF_CLOBBER = 0)
EXTERNAL nf_close
INTEGER(w2f__i4) nf_close
INTEGER(w2f__i4) NF_DOUBLE
PARAMETER ( NF_DOUBLE = 6)
INTEGER(w2f__i4) NF_EBADDIM
PARAMETER ( NF_EBADDIM = -46)
INTEGER(w2f__i4) NF_EBADID
PARAMETER ( NF_EBADID = -33)
INTEGER(w2f__i4) NF_EBADNAME
PARAMETER ( NF_EBADNAME = -59)
INTEGER(w2f__i4) NF_EBADTYPE
PARAMETER ( NF_EBADTYPE = -45)
INTEGER(w2f__i4) NF_ECHAR
PARAMETER ( NF_ECHAR = -56)
INTEGER(w2f__i4) NF_EEDGE
PARAMETER ( NF_EEDGE = -57)
INTEGER(w2f__i4) NF_EEXIST
PARAMETER ( NF_EEXIST = -35)
INTEGER(w2f__i4) NF_EGLOBAL
PARAMETER ( NF_EGLOBAL = -50)
INTEGER(w2f__i4) NF_EINDEFINE
PARAMETER ( NF_EINDEFINE = -39)
INTEGER(w2f__i4) NF_EINVAL
PARAMETER ( NF_EINVAL = -36)
INTEGER(w2f__i4) NF_EINVALCOORDS
PARAMETER ( NF_EINVALCOORDS = -40)
INTEGER(w2f__i4) NF_EMAXATTS
PARAMETER ( NF_EMAXATTS = -44)
INTEGER(w2f__i4) NF_EMAXDIMS
PARAMETER ( NF_EMAXDIMS = -41)
INTEGER(w2f__i4) NF_EMAXNAME
PARAMETER ( NF_EMAXNAME = -53)
INTEGER(w2f__i4) NF_EMAXVARS
PARAMETER ( NF_EMAXVARS = -48)
INTEGER(w2f__i4) NF_ENAMEINUSE
PARAMETER ( NF_ENAMEINUSE = -42)
INTEGER(w2f__i4) NF_ENOMEM
PARAMETER ( NF_ENOMEM = -61)
INTEGER(w2f__i4) NF_ENORECVARS
PARAMETER ( NF_ENORECVARS = -55)
INTEGER(w2f__i4) NF_ENOTATT
PARAMETER ( NF_ENOTATT = -43)
INTEGER(w2f__i4) NF_ENOTINDEFINE
PARAMETER ( NF_ENOTINDEFINE = -38)
INTEGER(w2f__i4) NF_ENOTNC
PARAMETER ( NF_ENOTNC = -51)
INTEGER(w2f__i4) NF_ENOTVAR
PARAMETER ( NF_ENOTVAR = -49)
INTEGER(w2f__i4) NF_EPERM
PARAMETER ( NF_EPERM = -37)
INTEGER(w2f__i4) NF_ERANGE
PARAMETER ( NF_ERANGE = -60)
INTEGER(w2f__i4) NF_ESTRIDE
PARAMETER ( NF_ESTRIDE = -58)
INTEGER(w2f__i4) NF_ESTS
PARAMETER ( NF_ESTS = -52)
INTEGER(w2f__i4) NF_EUNLIMIT
PARAMETER ( NF_EUNLIMIT = -54)
INTEGER(w2f__i4) NF_EUNLIMPOS
PARAMETER ( NF_EUNLIMPOS = -47)
INTEGER(w2f__i4) NF_FATAL
PARAMETER ( NF_FATAL = 1)
INTEGER(w2f__i4) NF_FILL
PARAMETER ( NF_FILL = 0)
INTEGER(w2f__i4) NF_FILL_BYTE
PARAMETER ( NF_FILL_BYTE = -127)
INTEGER(w2f__i4) NF_FILL_CHAR
PARAMETER ( NF_FILL_CHAR = 0)
REAL(w2f__8) NF_FILL_DOUBLE
PARAMETER ( NF_FILL_DOUBLE = 9.969209968386869d+36)
REAL(w2f__4) NF_FILL_FLOAT
PARAMETER ( NF_FILL_FLOAT = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_INT
PARAMETER ( NF_FILL_INT = -2147483647)
INTEGER(w2f__i4) NF_FILL_INT1
PARAMETER ( NF_FILL_INT1 = -127)
INTEGER(w2f__i4) NF_FILL_INT2
PARAMETER ( NF_FILL_INT2 = -32767)
REAL(w2f__4) NF_FILL_REAL
PARAMETER ( NF_FILL_REAL = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_SHORT
PARAMETER ( NF_FILL_SHORT = -32767)
INTEGER(w2f__i4) NF_FLOAT
PARAMETER ( NF_FLOAT = 5)
INTEGER(w2f__i4) NF_GLOBAL
PARAMETER ( NF_GLOBAL = 0)
INTEGER(w2f__i4) NF_INT
PARAMETER ( NF_INT = 4)
INTEGER(w2f__i4) NF_INT1
PARAMETER ( NF_INT1 = 1)
INTEGER(w2f__i4) NF_INT2
PARAMETER ( NF_INT2 = 3)
INTEGER(w2f__i4) NF_LOCK
PARAMETER ( NF_LOCK = 1024)
INTEGER(w2f__i4) NF_MAX_ATTRS
PARAMETER ( NF_MAX_ATTRS = 4096)
INTEGER(w2f__i4) NF_MAX_DIMS
PARAMETER ( NF_MAX_DIMS = 512)
INTEGER(w2f__i4) NF_MAX_NAME
PARAMETER ( NF_MAX_NAME = 128)
INTEGER(w2f__i4) NF_MAX_VARS
PARAMETER ( NF_MAX_VARS = 4096)
INTEGER(w2f__i4) NF_MAX_VAR_DIMS
PARAMETER ( NF_MAX_VAR_DIMS = 512)
INTEGER(w2f__i4) NF_NOCLOBBER
PARAMETER ( NF_NOCLOBBER = 4)
INTEGER(w2f__i4) NF_NOERR
PARAMETER ( NF_NOERR = 0)
INTEGER(w2f__i4) NF_NOFILL
PARAMETER ( NF_NOFILL = 256)
INTEGER(w2f__i4) NF_NOWRITE
PARAMETER ( NF_NOWRITE = 0)
EXTERNAL nf_open
INTEGER(w2f__i4) nf_open
EXTERNAL nf_put_att_double
INTEGER(w2f__i4) nf_put_att_double
INTEGER(w2f__i4) NF_REAL
PARAMETER ( NF_REAL = 5)
EXTERNAL nf_redef
INTEGER(w2f__i4) nf_redef
INTEGER(w2f__i4) NF_SHARE
PARAMETER ( NF_SHARE = 2048)
INTEGER(w2f__i4) NF_SHORT
PARAMETER ( NF_SHORT = 3)
INTEGER(w2f__i4) NF_SIZEHINT_DEFAULT
PARAMETER ( NF_SIZEHINT_DEFAULT = 0)
INTEGER(w2f__i4) NF_TYPE
INTEGER(w2f__i4) NF_UNLIMITED
PARAMETER ( NF_UNLIMITED = 0)
INTEGER(w2f__i4) NF_VERBOSE
PARAMETER ( NF_VERBOSE = 2)
INTEGER(w2f__i4) NF_WRITE
PARAMETER ( NF_WRITE = 1)
EXTERNAL set_nf_real_type
CHARACTER(80) STR1
C
C **** statements ****
C
CALL set_nf_real_type(NF_TYPE)
STR1 = 'nf_open'
ERRMSG = nf_open(FNAME, (1), FID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_redef'
ERRMSG = nf_redef(FID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_put_att_double ' // ANAME
ERRMSG = nf_put_att_double(FID, (0), ANAME, NF_TYPE, (1), A)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_close'
ERRMSG = nf_close(FID)
CALL handle_err(ERRMSG, STR1)
RETURN
END SUBROUTINE
SUBROUTINE add_coordinates_netcdf(FNAME, NX, X, NY, Y, UNITS)
use w2f__types
use active_module
IMPLICIT NONE
C
C **** Parameters and Result ****
C
CHARACTER(80) FNAME
INTEGER(w2f__i4) NX
type(active) :: X(1 : NX)
INTEGER(w2f__i4) NY
type(active) :: Y(1 : NY)
CHARACTER(80) UNITS
C
C **** Local Variables and functions ****
C
INTEGER(w2f__i8) t__62
INTEGER(w2f__i8) t__64
INTEGER(w2f__i8) t__63
INTEGER(w2f__i8) t__65
INTEGER(w2f__i4) DID
INTEGER(w2f__i4) ERRMSG
INTEGER(w2f__i4) FID
INTEGER(w2f__i4) FILBYTE
PARAMETER ( FILBYTE = -127)
INTEGER(w2f__i4) FILCHAR
PARAMETER ( FILCHAR = 0)
REAL(w2f__8) FILDOUB
PARAMETER ( FILDOUB = 9.969209968386869d+36)
REAL(w2f__4) FILFLOAT
PARAMETER ( FILFLOAT = 9.969210d+36)
INTEGER(w2f__i4) FILLONG
PARAMETER ( FILLONG = -2147483647)
INTEGER(w2f__i4) FILSHORT
PARAMETER ( FILSHORT = -32767)
CHARACTER(1) GRID
EXTERNAL handle_err
INTEGER(w2f__i4) IX
INTEGER(w2f__i4) IY
INTEGER(w2f__i4) MAXNCATT
PARAMETER ( MAXNCATT = 2000)
INTEGER(w2f__i4) MAXNCDIM
PARAMETER ( MAXNCDIM = 100)
INTEGER(w2f__i4) MAXNCNAM
PARAMETER ( MAXNCNAM = 128)
INTEGER(w2f__i4) MAXNCOP
PARAMETER ( MAXNCOP = 32)
INTEGER(w2f__i4) MAXNCVAR
PARAMETER ( MAXNCVAR = 2000)
INTEGER(w2f__i4) MAXVDIMS
PARAMETER ( MAXVDIMS = 100)
INTEGER(w2f__i4) NCBYTE
PARAMETER ( NCBYTE = 1)
INTEGER(w2f__i4) NCCHAR
PARAMETER ( NCCHAR = 2)
INTEGER(w2f__i4) NCCLOB
PARAMETER ( NCCLOB = 0)
INTEGER(w2f__i4) NCCREAT
PARAMETER ( NCCREAT = 2)
INTEGER(w2f__i4) NCDOUBLE
PARAMETER ( NCDOUBLE = 6)
INTEGER(w2f__i4) NCEBADD
PARAMETER ( NCEBADD = -46)
INTEGER(w2f__i4) NCEBADID
PARAMETER ( NCEBADID = -33)
INTEGER(w2f__i4) NCEBADTY
PARAMETER ( NCEBADTY = -45)
INTEGER(w2f__i4) NCECOORD
PARAMETER ( NCECOORD = -40)
INTEGER(w2f__i4) NCEEXIST
PARAMETER ( NCEEXIST = -35)
INTEGER(w2f__i4) NCEGLOB
PARAMETER ( NCEGLOB = -50)
INTEGER(w2f__i4) NCEINDEF
PARAMETER ( NCEINDEF = -39)
INTEGER(w2f__i4) NCEINVAL
PARAMETER ( NCEINVAL = -36)
INTEGER(w2f__i4) NCEMAXAT
PARAMETER ( NCEMAXAT = -44)
INTEGER(w2f__i4) NCEMAXDS
PARAMETER ( NCEMAXDS = -41)
INTEGER(w2f__i4) NCEMAXVS
PARAMETER ( NCEMAXVS = -48)
INTEGER(w2f__i4) NCENAME
PARAMETER ( NCENAME = -42)
INTEGER(w2f__i4) NCENFILE
PARAMETER ( NCENFILE = -31)
INTEGER(w2f__i4) NCENOATT
PARAMETER ( NCENOATT = -43)
INTEGER(w2f__i4) NCENOTIN
PARAMETER ( NCENOTIN = -38)
INTEGER(w2f__i4) NCENOTNC
PARAMETER ( NCENOTNC = -51)
INTEGER(w2f__i4) NCENOTVR
PARAMETER ( NCENOTVR = -49)
INTEGER(w2f__i4) NCENTOOL
PARAMETER ( NCENTOOL = -53)
INTEGER(w2f__i4) NCEPERM
PARAMETER ( NCEPERM = -37)
INTEGER(w2f__i4) NCESTS
PARAMETER ( NCESTS = -52)
INTEGER(w2f__i4) NCEUNLIM
PARAMETER ( NCEUNLIM = -47)
INTEGER(w2f__i4) NCEXCL
PARAMETER ( NCEXCL = 4)
INTEGER(w2f__i4) NCFATAL
PARAMETER ( NCFATAL = 1)
INTEGER(w2f__i4) NCFILL
PARAMETER ( NCFILL = 0)
INTEGER(w2f__i4) NCFLOAT
PARAMETER ( NCFLOAT = 5)
INTEGER(w2f__i4) NCFOOBAR
PARAMETER ( NCFOOBAR = 32)
INTEGER(w2f__i4) NCGLOBAL
PARAMETER ( NCGLOBAL = 0)
INTEGER(w2f__i4) NCHDIRTY
PARAMETER ( NCHDIRTY = 128)
INTEGER(w2f__i4) NCHSYNC
PARAMETER ( NCHSYNC = 32)
INTEGER(w2f__i4) NCINDEF
PARAMETER ( NCINDEF = 8)
INTEGER(w2f__i4) NCLINK
PARAMETER ( NCLINK = 32768)
INTEGER(w2f__i4) NCLONG
PARAMETER ( NCLONG = 4)
INTEGER(w2f__i4) NCNDIRTY
PARAMETER ( NCNDIRTY = 64)
INTEGER(w2f__i4) NCNOCLOB
PARAMETER ( NCNOCLOB = 4)
INTEGER(w2f__i4) NCNOERR
PARAMETER ( NCNOERR = 0)
INTEGER(w2f__i4) NCNOFILL
PARAMETER ( NCNOFILL = 256)
INTEGER(w2f__i4) NCNOWRIT
PARAMETER ( NCNOWRIT = 0)
INTEGER(w2f__i4) NCNSYNC
PARAMETER ( NCNSYNC = 16)
INTEGER(w2f__i4) NCRDWR
PARAMETER ( NCRDWR = 1)
INTEGER(w2f__i4) NCSHORT
PARAMETER ( NCSHORT = 3)
INTEGER(w2f__i4) NCSYSERR
PARAMETER ( NCSYSERR = -31)
INTEGER(w2f__i4) NCUNLIM
PARAMETER ( NCUNLIM = 0)
INTEGER(w2f__i4) NCVERBOS
PARAMETER ( NCVERBOS = 2)
INTEGER(w2f__i4) NCWRITE
PARAMETER ( NCWRITE = 1)
INTEGER(w2f__i4) NF_ALIGN_CHUNK
PARAMETER ( NF_ALIGN_CHUNK = -1)
INTEGER(w2f__i4) NF_BYTE
PARAMETER ( NF_BYTE = 1)
INTEGER(w2f__i4) NF_CHAR
PARAMETER ( NF_CHAR = 2)
INTEGER(w2f__i4) NF_CLOBBER
PARAMETER ( NF_CLOBBER = 0)
EXTERNAL nf_close
INTEGER(w2f__i4) nf_close
EXTERNAL nf_def_var
INTEGER(w2f__i4) nf_def_var
INTEGER(w2f__i4) NF_DOUBLE
PARAMETER ( NF_DOUBLE = 6)
INTEGER(w2f__i4) NF_EBADDIM
PARAMETER ( NF_EBADDIM = -46)
INTEGER(w2f__i4) NF_EBADID
PARAMETER ( NF_EBADID = -33)
INTEGER(w2f__i4) NF_EBADNAME
PARAMETER ( NF_EBADNAME = -59)
INTEGER(w2f__i4) NF_EBADTYPE
PARAMETER ( NF_EBADTYPE = -45)
INTEGER(w2f__i4) NF_ECHAR
PARAMETER ( NF_ECHAR = -56)
INTEGER(w2f__i4) NF_EEDGE
PARAMETER ( NF_EEDGE = -57)
INTEGER(w2f__i4) NF_EEXIST
PARAMETER ( NF_EEXIST = -35)
INTEGER(w2f__i4) NF_EGLOBAL
PARAMETER ( NF_EGLOBAL = -50)
INTEGER(w2f__i4) NF_EINDEFINE
PARAMETER ( NF_EINDEFINE = -39)
INTEGER(w2f__i4) NF_EINVAL
PARAMETER ( NF_EINVAL = -36)
INTEGER(w2f__i4) NF_EINVALCOORDS
PARAMETER ( NF_EINVALCOORDS = -40)
INTEGER(w2f__i4) NF_EMAXATTS
PARAMETER ( NF_EMAXATTS = -44)
INTEGER(w2f__i4) NF_EMAXDIMS
PARAMETER ( NF_EMAXDIMS = -41)
INTEGER(w2f__i4) NF_EMAXNAME
PARAMETER ( NF_EMAXNAME = -53)
INTEGER(w2f__i4) NF_EMAXVARS
PARAMETER ( NF_EMAXVARS = -48)
INTEGER(w2f__i4) NF_ENAMEINUSE
PARAMETER ( NF_ENAMEINUSE = -42)
EXTERNAL nf_enddef
INTEGER(w2f__i4) nf_enddef
INTEGER(w2f__i4) NF_ENOMEM
PARAMETER ( NF_ENOMEM = -61)
INTEGER(w2f__i4) NF_ENORECVARS
PARAMETER ( NF_ENORECVARS = -55)
INTEGER(w2f__i4) NF_ENOTATT
PARAMETER ( NF_ENOTATT = -43)
INTEGER(w2f__i4) NF_ENOTINDEFINE
PARAMETER ( NF_ENOTINDEFINE = -38)
INTEGER(w2f__i4) NF_ENOTNC
PARAMETER ( NF_ENOTNC = -51)
INTEGER(w2f__i4) NF_ENOTVAR
PARAMETER ( NF_ENOTVAR = -49)
INTEGER(w2f__i4) NF_EPERM
PARAMETER ( NF_EPERM = -37)
INTEGER(w2f__i4) NF_ERANGE
PARAMETER ( NF_ERANGE = -60)
INTEGER(w2f__i4) NF_ESTRIDE
PARAMETER ( NF_ESTRIDE = -58)
INTEGER(w2f__i4) NF_ESTS
PARAMETER ( NF_ESTS = -52)
INTEGER(w2f__i4) NF_EUNLIMIT
PARAMETER ( NF_EUNLIMIT = -54)
INTEGER(w2f__i4) NF_EUNLIMPOS
PARAMETER ( NF_EUNLIMPOS = -47)
INTEGER(w2f__i4) NF_FATAL
PARAMETER ( NF_FATAL = 1)
INTEGER(w2f__i4) NF_FILL
PARAMETER ( NF_FILL = 0)
INTEGER(w2f__i4) NF_FILL_BYTE
PARAMETER ( NF_FILL_BYTE = -127)
INTEGER(w2f__i4) NF_FILL_CHAR
PARAMETER ( NF_FILL_CHAR = 0)
REAL(w2f__8) NF_FILL_DOUBLE
PARAMETER ( NF_FILL_DOUBLE = 9.969209968386869d+36)
REAL(w2f__4) NF_FILL_FLOAT
PARAMETER ( NF_FILL_FLOAT = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_INT
PARAMETER ( NF_FILL_INT = -2147483647)
INTEGER(w2f__i4) NF_FILL_INT1
PARAMETER ( NF_FILL_INT1 = -127)
INTEGER(w2f__i4) NF_FILL_INT2
PARAMETER ( NF_FILL_INT2 = -32767)
REAL(w2f__4) NF_FILL_REAL
PARAMETER ( NF_FILL_REAL = 9.969210d+36)
INTEGER(w2f__i4) NF_FILL_SHORT
PARAMETER ( NF_FILL_SHORT = -32767)
INTEGER(w2f__i4) NF_FLOAT
PARAMETER ( NF_FLOAT = 5)
INTEGER(w2f__i4) NF_GLOBAL
PARAMETER ( NF_GLOBAL = 0)
EXTERNAL nf_inq_dimid
INTEGER(w2f__i4) nf_inq_dimid
INTEGER(w2f__i4) NF_INT
PARAMETER ( NF_INT = 4)
INTEGER(w2f__i4) NF_INT1
PARAMETER ( NF_INT1 = 1)
INTEGER(w2f__i4) NF_INT2
PARAMETER ( NF_INT2 = 3)
INTEGER(w2f__i4) NF_LOCK
PARAMETER ( NF_LOCK = 1024)
INTEGER(w2f__i4) NF_MAX_ATTRS
PARAMETER ( NF_MAX_ATTRS = 4096)
INTEGER(w2f__i4) NF_MAX_DIMS
PARAMETER ( NF_MAX_DIMS = 512)
INTEGER(w2f__i4) NF_MAX_NAME
PARAMETER ( NF_MAX_NAME = 128)
INTEGER(w2f__i4) NF_MAX_VARS
PARAMETER ( NF_MAX_VARS = 4096)
INTEGER(w2f__i4) NF_MAX_VAR_DIMS
PARAMETER ( NF_MAX_VAR_DIMS = 512)
INTEGER(w2f__i4) NF_NOCLOBBER
PARAMETER ( NF_NOCLOBBER = 4)
INTEGER(w2f__i4) NF_NOERR
PARAMETER ( NF_NOERR = 0)
INTEGER(w2f__i4) NF_NOFILL
PARAMETER ( NF_NOFILL = 256)
INTEGER(w2f__i4) NF_NOWRITE
PARAMETER ( NF_NOWRITE = 0)
EXTERNAL nf_open
INTEGER(w2f__i4) nf_open
EXTERNAL nf_put_att_double
INTEGER(w2f__i4) nf_put_att_double
EXTERNAL nf_put_att_text
INTEGER(w2f__i4) nf_put_att_text
EXTERNAL nf_put_var_double_ad1
INTEGER(w2f__i4) nf_put_var_double_ad1
INTEGER(w2f__i4) NF_REAL
PARAMETER ( NF_REAL = 5)
EXTERNAL nf_redef
INTEGER(w2f__i4) nf_redef
INTEGER(w2f__i4) NF_SHARE
PARAMETER ( NF_SHARE = 2048)
INTEGER(w2f__i4) NF_SHORT
PARAMETER ( NF_SHORT = 3)
INTEGER(w2f__i4) NF_SIZEHINT_DEFAULT
PARAMETER ( NF_SIZEHINT_DEFAULT = 0)
INTEGER(w2f__i4) NF_TYPE
INTEGER(w2f__i4) NF_UNLIMITED
PARAMETER ( NF_UNLIMITED = 0)
INTEGER(w2f__i4) NF_VERBOSE
PARAMETER ( NF_VERBOSE = 2)
INTEGER(w2f__i4) NF_WRITE
PARAMETER ( NF_WRITE = 1)
type(active) :: RANGE(1 : 2)
EXTERNAL set_nf_real_type
CHARACTER(80) STR1
CHARACTER(80) STR2
INTEGER(w2f__i4) TID
INTEGER(w2f__i4) XID
INTEGER(w2f__i4) YID
C
C **** Temporary variables ****
C
INTEGER(w2f__i4) doloop_ub
INTEGER(w2f__i4) doloop_ub0
C
C **** statements ****
C
t__62 = NX
t__64 = MAX(t__62, 0_w2f__i8)
t__63 = NY
t__65 = MAX(t__63, 0_w2f__i8)
IF(UNITS .EQ. 'deg') THEN
GRID = 's'
ELSE
IF(UNITS .EQ. 'meters') THEN
GRID = 'c'
ELSE
WRITE(*, *) ' no propery x/y units specified'
ENDIF
ENDIF
CALL set_nf_real_type(NF_TYPE)
STR1 = 'nf_open'
ERRMSG = nf_open(FNAME, (1), FID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_redef'
ERRMSG = nf_redef(FID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'TIME'
STR2 = 'nf_inq_dimid: TIME'
ERRMSG = nf_inq_dimid(FID, STR1, DID)
CALL handle_err(ERRMSG, STR2)
STR1 = 'TIME'
STR2 = 'nf_def_var: TIME'
ERRMSG = nf_def_var(FID, STR1, NF_TYPE, (1), DID, TID)
CALL handle_err(ERRMSG, STR2)
STR1 = 'nf_put_att_text: TIME: long_name'
STR2 = 'nf_put_att_text: TIME: units'
ERRMSG = nf_put_att_text(FID, TID, 'long_name', (19),
> 'time of integration')
CALL handle_err(ERRMSG, STR1)
ERRMSG = nf_put_att_text(FID, TID, 'units', (7), 'seconds')
CALL handle_err(ERRMSG, STR2)
STR1 = 'nf_inq_dimid: X'
ERRMSG = nf_inq_dimid(FID, 'X', DID)
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_def_var: X'
ERRMSG = nf_def_var(FID, 'X', NF_TYPE, (1), DID, XID)
CALL handle_err(ERRMSG, STR1)
IF(GRID .EQ. 's') THEN
ERRMSG = nf_put_att_text(FID, XID, 'long_name', (9),
> 'longitude')
ELSE
IF(GRID .EQ. 'c') THEN
ERRMSG = nf_put_att_text(FID, XID, 'long_name', (12),
> 'X-coordinate')
ENDIF
ENDIF
STR1 = 'nf_put_att_text: X: long_name'
CALL handle_err(ERRMSG, STR1)
IF(GRID .EQ. 's') THEN
ERRMSG = nf_put_att_text((FID), (XID), 'units', LEN(UNITS) + 1,
> (UNITS // 'E'))
ELSE
IF(GRID .EQ. 'c') THEN
ERRMSG = nf_put_att_text(FID, XID, 'units', LEN(UNITS), UNITS
> )
ENDIF
ENDIF
STR1 = 'nf_put_att_text: X: units'
CALL handle_err(ERRMSG, STR1)
RANGE(1)%v = 9.99999999999999916114D+22
RANGE(2)%v = (-9.99999999999999916114D+22)
CALL zero_deriv(RANGE(1))
CALL zero_deriv(RANGE(2))
doloop_ub = NX
DO IX = 1, doloop_ub, 1
IF (X(IX)%v .LT. RANGE(1)%v) THEN
RANGE(1)%v = X(IX)%v
CALL setderiv(RANGE(1),X(IX))
ENDIF
IF (X(IX)%v .GT. RANGE(2)%v) THEN
RANGE(2)%v = X(IX)%v
CALL setderiv(RANGE(2),X(IX))
ENDIF
END DO
ERRMSG = nf_put_att_double(FID, XID, 'valid_range', NF_TYPE, (2),
> RANGE)
STR1 = 'nf_put_att_text: X: valid_range'
CALL handle_err(ERRMSG, STR1)
ERRMSG = nf_inq_dimid(FID, 'Y', DID)
STR1 = 'nf_inq_dimid: Y'
CALL handle_err(ERRMSG, STR1)
STR1 = 'nf_def_var: Y'
ERRMSG = nf_def_var(FID, 'Y', NF_TYPE, (1), DID, YID)
CALL handle_err(ERRMSG, STR1)
IF(GRID .EQ. 's') THEN
ERRMSG = nf_put_att_text(FID, YID, 'long_name', (8), 'latitude'
> )
ELSE
IF(GRID .EQ. 'c') THEN
ERRMSG = nf_put_att_text(FID, YID, 'long_name', (12),
> 'Y-coordinate')
ENDIF
ENDIF
STR1 = 'nf_put_att_text: Y: long_name'
CALL handle_err(ERRMSG, STR1)
IF(GRID .EQ. 's') THEN
ERRMSG = nf_put_att_text((FID), (YID), 'units', LEN(UNITS) + 1,
> (UNITS // 'N'))
ELSE
IF(GRI