subroutine Process_main ( 1,12FPPROC1.36
*CALL AFLDDIMS 
FPPROC1.37
# ppxRecs,icode) FPPROC1.38
FPPROC1.39
implicit none FPPROC1.40
FPPROC1.41
! parameters used FPPROC1.42
*CALL CSUBMODL FPPROC1.43
*CALL CPPXREF FPPROC1.44
*CALL PPXLOOK FPPROC1.45
FPPROC1.46
! declaration of argument list FPPROC1.47
*CALL CFLDDIMS FPPROC1.48
FPPROC1.49
integer icode ! IN/OUT error code ; > 0 => fatal error detected FPPROC1.50
FPPROC1.51
FPPROC1.52
! no local parameters FPPROC1.53
FPPROC1.54
! declaration of globals used FPPROC1.55
*CALL CUNITNOS FPPROC1.56
*CALL CMESS FPPROC1.57
FPPROC1.58
! declaration of local arrays (all arrays in COMDECK CFIELDS) FPPROC1.59
*CALL CLSMS FPPROC1.60
*CALL CCOORDS FPPROC1.61
*CALL CINTERP FPPROC1.62
*CALL CFILLIN FPPROC1.63
*CALL CROTGRD FPPROC1.64
*CALL CSELCT FPPROC1.65
FPPROC1.66
! local scalars FPPROC1.67
integer IROW_NUMBER FPPROC1.68
character*80 cmessage FPPROC1.69
FPPROC1.70
! declaration of externals FPPROC1.71
external read_lsms, winds FPPROC1.72
# , heat, moisture, sea_ice, reference, pressure FPPROC1.73
!---------------------------------------------------------------------- FPPROC1.74
! 0. Preliminaries FPPROC1.75
CSub = 'Process_main' ! subroutine name for error messages FPPROC1.76
FPPROC1.77
! 0.1 Read StashMaster files FPPROC1.78
FPPROC1.79
IROW_NUMBER=0 FPPROC1.80
CALL GETPPX(22,2,'STASHmaster_A',IROW_NUMBER, FPPROC1.81
*CALL ARGPPX FPPROC1.82
& ICODE,CMESSAGE) FPPROC1.83
CALL GETPPX(22,2,'STASHmaster_O',IROW_NUMBER, FPPROC1.84
*CALL ARGPPX FPPROC1.85
& ICODE,CMESSAGE) FPPROC1.86
CALL GETPPX(22,2,'STASHmaster_S',IROW_NUMBER, FPPROC1.87
*CALL ARGPPX FPPROC1.88
& ICODE,CMESSAGE) FPPROC1.89
CALL GETPPX(22,2,'STASHmaster_W',IROW_NUMBER, FPPROC1.90
*CALL ARGPPX FPPROC1.91
& ICODE,CMESSAGE) FPPROC1.92
FPPROC1.93
! 1. Read in land sea masks and calculate grid coordinates and FPPROC1.94
! coefficients for interpolation from atmosphere to ocean grids. FPPROC1.95
FPPROC1.96
call read_lsms ( FPPROC1.97
*CALL AFIELDS FPPROC1.98
*CALL ARGPPX FPPROC1.99
# icode) FPPROC1.100
FPPROC1.101
if ( icode .gt. 0 ) then FPPROC1.102
write(UnErr,*)CErr,CSub, FPPROC1.103
# ' step 1. error in read_lsms ' FPPROC1.104
go to 9999 FPPROC1.105
end if FPPROC1.106
FPPROC1.107
! 2. Produce the output flux files FPPROC1.108
! 2.1 produce wind flux file FPPROC1.109
FPPROC1.110
if (l_winds_slt) then FPPROC1.111
FPPROC1.112
call winds( FPPROC1.113
*CALL AFIELDS FPPROC1.114
*CALL ARGPPX FPPROC1.115
# icode) FPPROC1.116
FPPROC1.117
if ( icode .gt. 0 ) then FPPROC1.118
write(UnErr,*)CErr,CSub, FPPROC1.119
# ' step 2.1 error in winds ' FPPROC1.120
go to 9999 FPPROC1.121
end if FPPROC1.122
FPPROC1.123
end if ! l_winds_slt FPPROC1.124
FPPROC1.125
! 2.2 produce heat flux file FPPROC1.126
FPPROC1.127
if (l_heat_slt) then FPPROC1.128
FPPROC1.129
call heat( FPPROC1.130
*CALL AFIELDS FPPROC1.131
*CALL ARGPPX FPPROC1.132
# icode) FPPROC1.133
FPPROC1.134
if ( icode .gt. 0 ) then FPPROC1.135
write(UnErr,*)CErr,CSub, FPPROC1.136
# ' step 2.2 error in heat ' FPPROC1.137
go to 9999 FPPROC1.138
end if FPPROC1.139
FPPROC1.140
end if ! l_heat_slt FPPROC1.141
FPPROC1.142
! 2.3 produce moisture flux file FPPROC1.143
FPPROC1.144
if (l_moisture_slt) then FPPROC1.145
FPPROC1.146
call moisture( FPPROC1.147
*CALL AFIELDS FPPROC1.148
*CALL ARGPPX FPPROC1.149
# icode) FPPROC1.150
FPPROC1.151
if ( icode .gt. 0 ) then FPPROC1.152
write(UnErr,*)CErr,CSub, FPPROC1.153
# ' step 2.3 error in moisture ' FPPROC1.154
go to 9999 FPPROC1.155
end if FPPROC1.156
FPPROC1.157
end if ! l_moisture_slt FPPROC1.158
FPPROC1.159
! 2.4 produce sea ice flux file FPPROC1.160
FPPROC1.161
if (l_sea_ice_slt) then FPPROC1.162
FPPROC1.163
call sea_ice( FPPROC1.164
*CALL AFIELDS FPPROC1.165
*CALL ARGPPX FPPROC1.166
# icode) FPPROC1.167
FPPROC1.168
if ( icode .gt. 0 ) then FPPROC1.169
write(UnErr,*)CErr,CSub, FPPROC1.170
# ' step 2.4 error in sea_ice ' FPPROC1.171
go to 9999 FPPROC1.172
end if FPPROC1.173
FPPROC1.174
end if ! l_sea_ice_slt FPPROC1.175
FPPROC1.176
! 2.5 produce reference flux file FPPROC1.177
FPPROC1.178
if (l_references_slt) then FPPROC1.179
FPPROC1.180
call reference( FPPROC1.181
*CALL AFIELDS FPPROC1.182
*CALL ARGPPX FPPROC1.183
# icode) FPPROC1.184
FPPROC1.185
if ( icode .gt. 0 ) then FPPROC1.186
write(UnErr,*)CErr,CSub, FPPROC1.187
# ' step 2.5 error in reference ' FPPROC1.188
go to 9999 FPPROC1.189
end if FPPROC1.190
FPPROC1.191
end if ! l_references_slt FPPROC1.192
FPPROC1.193
! 2.6 produce pressure flux file FPPROC1.194
FPPROC1.195
if (l_pressure_slt) then FPPROC1.196
FPPROC1.197
call pressure( FPPROC1.198
*CALL AFIELDS FPPROC1.199
*CALL ARGPPX FPPROC1.200
# icode) FPPROC1.201
FPPROC1.202
if ( icode .gt. 0 ) then FPPROC1.203
write(UnErr,*)CErr,CSub, FPPROC1.204
# ' step 2.6 error in pressure ' FPPROC1.205
go to 9999 FPPROC1.206
end if FPPROC1.207
FPPROC1.208
end if ! l_pressure_slt FPPROC1.209
FPPROC1.210
! 2.7 produce wind speed flux file FPPROC1.211
FPPROC1.212
if (l_windspd_slt) then FPPROC1.213
FPPROC1.214
call windspd( FPPROC1.215
*CALL AFIELDS FPPROC1.216
*CALL ARGPPX FPPROC1.217
# icode) FPPROC1.218
FPPROC1.219
if ( icode .gt. 0 ) then FPPROC1.220
write(UnErr,*)CErr,CSub, FPPROC1.221
# ' step 2.7 error in windspd ' FPPROC1.222
go to 9999 FPPROC1.223
end if FPPROC1.224
FPPROC1.225
end if ! l_windspd_slt FPPROC1.226
FPPROC1.227
9999 continue FPPROC1.228
return FPPROC1.229
end FPPROC1.230
!---------------------------------------------------------------------- FPPROC1.231
*ENDIF FPPROC1.232