*IF DEF,CONTROL,AND,DEF,SLAB SLBSTU1A.2
C ******************************COPYRIGHT****************************** GTS2F400.9163
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9164
C GTS2F400.9165
C Use, duplication or disclosure of this code is subject to the GTS2F400.9166
C restrictions as set forth in the contract. GTS2F400.9167
C GTS2F400.9168
C Meteorological Office GTS2F400.9169
C London Road GTS2F400.9170
C BRACKNELL GTS2F400.9171
C Berkshire UK GTS2F400.9172
C RG12 2SZ GTS2F400.9173
C GTS2F400.9174
C If no contract has been raised with this copy of the code, the use, GTS2F400.9175
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9176
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9177
C Modelling at the above address. GTS2F400.9178
C ******************************COPYRIGHT****************************** GTS2F400.9179
C GTS2F400.9180
CLL Routine: SLABSTPU ------------------------------------------------ SLBSTU1A.3
CLL SLBSTU1A.4
CLL Purpose: To integrate slab ocean model by one timestep SLBSTU1A.5
CLL SLBSTU1A.6
CLL Called by: SLABSTEP SLBSTU1A.7
CLL SLBSTU1A.8
CLL Author: A.B.Keen Date: 5 July 1991 SLBSTU1A.9
CLL Modified: C.A.Senior Date: 22 March 1993 SLBSTU1A.10
CLL Modified: C.A.Senior Date: 30 March 1993 SLBSTU1A.11
CLL MODIFIED: A.B.KEEN DATE: 22 APRIL 1993 SLBSTU1A.12
CLL MODIFIED: A.B.KEEN DATE: 27 APRIL 1993 SLBSTU1A.13
CLL Modified: C.A.Senior Date: 08 July 1993 SLBSTU1A.14
CLL Reviewer: W.Ingram Date: 1 March 1993 SLBSTU1A.15
CLL Modified: C.A.Senior Date: 14 december 1993 SLBSTU1A.16
CLL Modified: C.A.Senior Date: 17 december 1993 SLBSTU1A.17
CLL Modified: C.A.Senior Date: 24 february 1994 SLBSTU1A.18
CLL Modified: C.A.Senior Date: 21 april 1994 SLBSTU1A.19
CLL Modified: J.F.Thomson Date: may 1994 SLBSTU1A.20
CLL Modified: R.E.Carnell Date: 13 september 1994 SLBSTU1A.21
CLL SLBSTU1A.22
CLL Tested under compiler: cft77 SLBSTU1A.23
CLL Tested under OS version: UNICOS 6.1 SLBSTU1A.24
CLL SLBSTU1A.25
CLL Code version no: 1 Date: 5 July 1991 SLBSTU1A.26
CLL Modification record: SLBSTU1A.27
CLL 14/12/93 Calling arg lists updated for 3.2 compatibility. SLBSTU1A.28
CLL 21/04/94 Calling arg lists updated for portable model SLBSTU1A.29
CLL 05/94 Dynamic sea ice and related control changes. SLBSTU1A.30
CLL 13/09/94 Switch for slab advection needed. SLBSTU1A.31
CLL 07/04/95 3.5 Submodel stage 1: replace slab_sm by slab_im GRR2F305.721
CLL (Slab is internal model not submodel). R.Rawlins GRR2F305.722
CLL 4.0 Add diagnostics for dynamic sea ice and vertical SST SJC1F400.133
CLL advection. J.F.Crossley SJC1F400.134
CLL 4.0 03/01/96 Copy atmos prognostics into Stashwork for GDR8F400.10
CLL SLAB diagnostics. D. Robinson GDR8F400.11
!LL 4.4 04/08/97 Add missing ARGOINDX to various argument lists. SDR1F404.28
!LL D. Robinson. SDR1F404.29
!LL 4.4 23/08/96 Declare & Initialise LGLOBAL. S. Mullerworth SSM1F404.1
!LL 4.5 03/09/98 Slab model has been modified to be SCH0F405.80
!LL compatible with atmosphere running mpp. Note: the SCH0F405.81
!LL cavitating fluid sea ice dynamics and slab temp. SCH0F405.82
!LL advection bits of code are not used at present and SCH0F405.83
!LL have not been taken into account in this coding. SCH0F405.84
!LL C. D. Hewitt SCH0F405.85
CLL GDR8F400.12
CLL programming standard : UM document 3 version 5 SLBSTU1A.32
CLL system components covered : P40 SLBSTU1A.33
CLL SLBSTU1A.34
CLL External documentation: UM Documentation paper 58 SLBSTU1A.35
CLL SLBSTU1A.36
CLLEND----------------------------------------------------------------- SLBSTU1A.37
C*L Arguments SLBSTU1A.38
SLBSTU1A.39
SUBROUTINE SLABSTPU( 1,104SLBSTU1A.40
*CALL ARGSIZE 
SLBSTU1A.41
*CALL ARGD1 SLBSTU1A.42
*CALL ARGDUMA SLBSTU1A.43
*CALL ARGDUMO SLBSTU1A.44
*CALL ARGDUMW GKR1F401.262
*CALL ARGSTS SLBSTU1A.45
*CALL ARGPTRA SLBSTU1A.46
*CALL ARGPTRO SLBSTU1A.47
*CALL ARGCONA SLBSTU1A.48
*CALL ARGPPX GKR0F305.983
*CALL ARGOINDX SDR1F404.30
*IF DEF,MPP SCH0F405.86
& WORK_FLD_SIZE, SCH0F405.87
& WORK_FLD_SIZEU, SCH0F405.88
*ENDIF SCH0F405.89
* INT40,FIELD_LEN, SLBSTU1A.49
* ICODE,CMESSAGE) SLBSTU1A.50
SLBSTU1A.51
C SLBSTU1A.52
*CALL TYPSIZE SLBSTU1A.53
*CALL TYPD1 SLBSTU1A.54
*CALL TYPDUMA SLBSTU1A.55
*CALL TYPDUMO SLBSTU1A.56
*CALL TYPDUMW GKR1F401.263
*CALL TYPSTS SLBSTU1A.57
*CALL TYPPTRA SLBSTU1A.58
*CALL TYPPTRO SLBSTU1A.59
*CALL CMAXSIZE SLBSTU1A.60
*CALL TYPCONA SLBSTU1A.61
*CALL TYPOINDX SDR1F404.31
SLBSTU1A.62
INTEGER SLBSTU1A.63
*IF DEF,MPP SCH0F405.90
& WORK_FLD_SIZE, ! Size of full global field SCH0F405.91
& WORK_FLD_SIZEU, ! Size of full global field on U grid SCH0F405.92
*ENDIF SCH0F405.93
& INT40, ! IN: Length of STASHWORK array required SLBSTU1A.64
& FIELD_LEN, ! IN: Length of field passed via SLBSTU1A.65
& ! argument list for dynalloc SLBSTU1A.66
& ICODE ! OUT: Return code : 0 Normal Exit SLBSTU1A.67
C ! : >0 Error SLBSTU1A.68
CHARACTER*(80) SLBSTU1A.69
& CMESSAGE ! OUT: Error message if return code >0 SLBSTU1A.70
C* SLBSTU1A.71
CL Include COMDECKS SLBSTU1A.72
C SLBSTU1A.73
*CALL CSUBMODL SLBSTU1A.74
*CALL CTIME SLBSTU1A.75
*CALL CHSUNITS SLBSTU1A.76
*CALL CHISTORY GDR3F305.183
*CALL CCONTROL SLBSTU1A.78
*CALL CASPTR SLBSTU1A.79
*CALL CSLBDATA SLBSTU1A.80
*CALL C_GLOBAL SLBSTU1A.81
*CALL PPXLOOK GKR0F305.984
C SLBSTU1A.82
C STASH workspace for diagnostics SLBSTU1A.83
C SLBSTU1A.84
REAL STASHWORK(INT40) SLBSTU1A.85
C SLBSTU1A.86
C Local variables SLBSTU1A.87
C SLBSTU1A.88
INTEGER J ! loop counter SLBSTU1A.89
INTEGER im_ident ! Internal model identifier GDR4F305.143
INTEGER im_index ! Internal model index for stash GDR4F305.144
REAL DT SLBSTU1A.90
REAL REDHC(FIELD_LEN) ! Redistributed heat convergence SLBSTU1A.91
REAL GBMICE(FIELD_LEN) ! Grid Box Mean ice depth SLBSTU1A.92
REAL AINC_DYN(FIELD_LEN) ! Ice fraction increment due to SLBSTU1A.93
& ! dynamics. SLBSTU1A.94
REAL HINC_DYN(FIELD_LEN) ! Ice depth increment due to SLBSTU1A.95
& ! dynamics. SLBSTU1A.96
REAL HSINC_DYN(FIELD_LEN) ! Snow depth increment due to SLBSTU1A.97
& ! dynamics * ice fraction. SJC1F400.135
REAL AINC_THERM(FIELD_LEN) ! Ice fraction increment (therm) SLBSTU1A.99
REAL HINC_THERM(FIELD_LEN) ! Ice depth increment (therm) SLBSTU1A.100
REAL HSINC_THERM(FIELD_LEN)! Snow depth increment (therm) SJC1F400.136
& ! * ice fraction. SJC1F400.137
REAL HINC_DIFF(FIELD_LEN) ! Ice depth increment (diffusion). SLBSTU1A.102
REAL HINC_ADV(FIELD_LEN) ! Ice depth increment (advection). SJC1F400.138
REAL HSINC_ADV(FIELD_LEN) ! Snow depth increment (advection) SJC1F400.139
& ! * ice fraction. SJC1F400.140
REAL AREAS(FIELD_LEN) ! Grid box areas. SJC1F400.141
REAL OIFLUX(FIELD_LEN) ! Ocean to ice heat flux. SLBSTU1A.103
REAL PRESSURE(FIELD_LEN) ! Internal ice pressure. SLBSTU1A.104
REAL PMAX(FIELD_LEN) ! Ice strength. SLBSTU1A.105
REAL wtsfc(FIELD_LEN) ! w x slabtemp surface SJC1F400.142
REAL wtbase(FIELD_LEN) ! w x slabtemp base SJC1F400.143
REAL ATMSFLUX(FIELD_LEN) ! Net heat flux into slab SJC1F400.144
& ! through leads. SJC1F400.145
REAL LEADFLUX(FIELD_LEN) ! Net heat flux into ice SJC1F400.146
& ! through leads. SJC1F400.147
REAL DTADV(FIELD_LEN) ! Change in slab temp due to SJC1F400.148
& ! advection. SJC1F400.149
REAL DTDIFF(FIELD_LEN) ! Change in slab temp due to SJC1F400.150
& ! diffusion. SJC1F400.151
REAL CARYHEAT(FIELD_LEN) ! Negative heat flux (W M-2) due to SJC1F400.152
& ! slab temps below freezing. SJC1F400.153
REAL DTICE(FIELD_LEN) ! Change in slab temp due to SJC1F400.154
& ! ice fluxes. SJC1F400.155
REAL SNOWSLAB(FIELD_LEN) ! Snowfall rate melting in open ocean. SJC1F400.156
REAL SNOWLEAD(FIELD_LEN) ! Snowfall rate melting in leads. SJC1F400.157
C SLBSTU1A.106
C Set to true if Global model SSM1F404.2
LOGICAL LGLOBAL SSM1F404.3
*IF DEF,MPP SCH0F405.94
*CALL PARVARS SCH0F405.95
*CALL GCCOM SCH0F405.96
INTEGER info SCH0F405.97
C Set up local global variables SCH0F405.98
LOGICAL LAND(WORK_FLD_SIZE) ! IN ATMOSPHERIC MODEL LAND-SEA MASK SCH0F405.99
+ ! FALSE AT OCEAN POINTS SCH0F405.100
REAL SCH0F405.101
+ SOLARIN(WORK_FLD_SIZE) ! IN NET DOWNWARD SW FLUX FROM THE SCH0F405.102
+ ! ATMOSPHERE (ALL FREQUENCIES). SCH0F405.103
+,BLUEIN(WORK_FLD_SIZE) ! IN NET DOWNWARD SW FLUX FROM THE SCH0F405.104
+ ! ATMOSPHERE (BAND 1, SEA POINTS) SCH0F405.105
+,EVAP(WORK_FLD_SIZE) ! IN SURFACE EVAP FROM THE WATER SCH0F405.106
+ ! FRACTION OF ALL OCEAN POINTS. AT SEA-ICE SCH0F405.107
+ ! POINTS, THIS IS WEIGHTED BY THE SCH0F405.108
+ ! FRACTIONAL LEAD AREA. (KG M-2 S-1) SCH0F405.109
+,LONGWAVE(WORK_FLD_SIZE) ! IN NET DOWNWARD LONGWAVE HEAT FLUX. SCH0F405.110
+,SENSIBLE(WORK_FLD_SIZE) ! IN SENS HEAT FLUX (+VE UPWARD) FOR SCH0F405.111
+ ! THE WATER FRACTION OF ALL OCEAN POINTS. SCH0F405.112
+ ! AREA-WEIGHTED AT SEA-ICE POINTS. SCH0F405.113
+,HEATCONV(WORK_FLD_SIZE) ! IN HEAT CONVERGENCE RATE, IN W M-2 SCH0F405.114
+,SNOWLS(WORK_FLD_SIZE) ! IN L-S SNOWFALL RATE (KG M-2 S-1) SCH0F405.115
+,SNOWCONV(WORK_FLD_SIZE) ! IN CONV SNOWFALL RATE (KG M-2 S-1) SCH0F405.116
+,TSTARATM(WORK_FLD_SIZE) ! INOUT SST FROM ATMOS MODEL (K) SCH0F405.117
+,SLABTEMP(WORK_FLD_SIZE) ! INOUT TEMP OF THE SLAB OCEAN (C) SCH0F405.118
+,HICEATM(WORK_FLD_SIZE) ! INOUT EQUIV ICE D FROM ATM MODL (M) SCH0F405.119
+,HSNOWATM(WORK_FLD_SIZE) ! INOUT SNOW D FROM ATM MODEL(KG M-2) SCH0F405.120
+,AICEATM(WORK_FLD_SIZE) ! INOUT ICE CONC FROM ATMOS MODEL SCH0F405.121
+,UICE(WORK_FLD_SIZEU) ! INOUT X COMPONENT OF ICE VELOCITY (m/s) SCH0F405.122
+,VICE(WORK_FLD_SIZEU) ! INOUT Y COMPONENT OF ICE VELOCITY (m/s) SCH0F405.123
+,SUBLIMA(WORK_FLD_SIZE) ! IN ACCUM SUBLIMATION, IN KG M-2 SCH0F405.124
+,TOPMELTZ(WORK_FLD_SIZE) ! IN RATE OF MELTING OF SNOW IN W M-2 SCH0F405.125
+ ! (THIS CAN BE TRANSFERRED TO ICE.) SCH0F405.126
+,BOTMELTZ(WORK_FLD_SIZE) ! IN DIFFUSIVE HT FX THRO ICE. W M-2 SCH0F405.127
+ ! IF THIS IS +VE, ICE MELTS AT THE BASE. SCH0F405.128
+ ! IF IT IS -VE, ICE ACCRETES THERE. SCH0F405.129
+,HICESLB(WORK_FLD_SIZE) ! OUT MEAN ICE D OVER WHOLE GRID BOX SCH0F405.130
+ ! IN M SCH0F405.131
+,TCLIM(WORK_FLD_SIZE) ! IN CLIMATOL. SEA SURFACE TEMPS K SCH0F405.132
+,HCLIM(WORK_FLD_SIZE) ! IN CLIMATOLOGICAL SEA-ICE DEPTHS M SCH0F405.133
+,ADJHCONV(WORK_FLD_SIZE) ! OUT REDISTRIBUTED HEAT CONVERGENCES SCH0F405.134
+,COS_P_LATITUDE_G(WORK_FLD_SIZE) ! IN COS LATITUDE ON P GRID SCH0F405.135
+,COS_U_LATITUDE_G(WORK_FLD_SIZEU) ! IN COS LATITUDE ON UV GRID SCH0F405.136
+,SEC_P_LATITUDE_G(WORK_FLD_SIZE) ! IN 1/COS LATITUDE ON P GRID SCH0F405.137
+,SIN_U_LATITUDE_G(WORK_FLD_SIZEU) ! IN SIN LATITUDE ON UV GRID SCH0F405.138
+,wtsfc_G(WORK_FLD_SIZE) ! OUT w x slab temp at surface SCH0F405.139
+,wtbase_G(WORK_FLD_SIZE) ! OUT w x slab temp at base SCH0F405.140
+,CORIOLIS(WORK_FLD_SIZE) ! IN 2*OMEGA*SIN(LAT) ON P GRID SCH0F405.141
+,UCURRENT(WORK_FLD_SIZEU) ! IN X COMPONENT OF SFC CURRENT (M/S) SCH0F405.142
+,VCURRENT(WORK_FLD_SIZEU) ! IN Y COMPONENT OF SFC CURRENT (M/S) SCH0F405.143
+,WSX(WORK_FLD_SIZEU) ! IN X COMPONENT OF SFC STRESS (N/M2) SCH0F405.144
+,WSY(WORK_FLD_SIZEU) ! IN Y COMPONENT OF SFC STRESS (N/M2) SCH0F405.145
+,AINC_THERM_G(WORK_FLD_SIZE) ! OUT ice fraction inc (therm) SCH0F405.146
+,HINC_THERM_G(WORK_FLD_SIZE) ! OUT ice depth inc (therm) SCH0F405.147
+,HSINC_THERM_G(WORK_FLD_SIZE) ! OUT snow d inc *ice fract (therm) SCH0F405.148
+,AINC_DYN_G(WORK_FLD_SIZE) ! OUT ice fraction inc (dynamics) SCH0F405.149
+,HINC_DYN_G(WORK_FLD_SIZE) ! OUT ice depth inc (dynamics) SCH0F405.150
+,HSINC_DYN_G(WORK_FLD_SIZE) ! OUT snow d inc *ice fract (dyn) SCH0F405.151
+,HINC_DIFF_G(WORK_FLD_SIZE) ! OUT ice depth inc (diffusion) SCH0F405.152
+,HINC_ADV_G(WORK_FLD_SIZE) ! OUT ice depth inc (advection) SCH0F405.153
+,HSINC_ADV_G(WORK_FLD_SIZE) ! OUT snow d inc *ice fract (advec) SCH0F405.154
+,AREAS_G(WORK_FLD_SIZE) ! OUT grid box areas SCH0F405.155
+,OIFLUX_G(WORK_FLD_SIZE) ! OUT ocean to ice heat flux SCH0F405.156
+,PRESSURE_G(WORK_FLD_SIZE) ! OUT internal ice pressure SCH0F405.157
+,PMAX_G(WORK_FLD_SIZE) ! OUT ice strength SCH0F405.158
+,ATMSFLUX_G(WORK_FLD_SIZE) ! OUT net heat into slab thro leads SCH0F405.159
+,LEADFLUX_G(WORK_FLD_SIZE) ! OUT net heat into ice thro leads SCH0F405.160
+,DTADV_G(WORK_FLD_SIZE) ! OUT slab hting rate due to advec SCH0F405.161
+,DTDIFF_G(WORK_FLD_SIZE) ! OUT slab hting rate due to diffus SCH0F405.162
+,CARYHEAT_G(WORK_FLD_SIZE) ! OUT -ve heat flux due to slab SCH0F405.163
+ ! temperatures falling below freezing. SCH0F405.164
+ ! W M-2 SCH0F405.165
+,SNOWSLAB_G(WORK_FLD_SIZE) ! OUT snowfall rate melting in slab SCH0F405.166
+,SNOWLEAD_G(WORK_FLD_SIZE) ! OUT snowfll rate melting in leads SCH0F405.167
+,DTICE_G(WORK_FLD_SIZE) ! OUT slb hting rt from ice melt etc SCH0F405.168
SCH0F405.169
*ENDIF SCH0F405.170
C External subroutines called SLBSTU1A.107
C SLBSTU1A.108
EXTERNAL SLBSTU1A.109
& SLABCNTL, SLBSTU1A.110
*IF DEF,MPP SCH0F405.171
& GATHER_FIELD, SCATTER_FIELD, SWAPBOUNDS, SCH0F405.172
*ENDIF SCH0F405.173
& TIMER, SLBSTU1A.111
& STASH SLBSTU1A.112
C SLBSTU1A.113
C SLBSTU1A.114
C SLBSTU1A.115
ICODE=0 SLBSTU1A.116
CMESSAGE=' ' SLBSTU1A.117
DT=REAL(SECS_PER_PERIODim(s_im))/REAL(STEPS_PER_PERIODim(s_im)) GRR2F305.723
C SLBSTU1A.119
WRITE(6,*) 'SLAB TIMESTEP ',STEPim(s_im) GDR8F400.13
C SLBSTU1A.121
im_ident = slab_im GDR4F305.145
im_index = internal_model_index(im_ident) GDR4F305.146
C SLBSTU1A.122
C Set global model flag from fixed length header SSM1F404.4
LGLOBAL = (A_FIXHD(4).EQ.0) SSM1F404.5
SSM1F404.6
SSM1F404.7
*IF DEF,MPP SCH0F405.174
C Gather all distributed variables to PE 0 SCH0F405.175
SCH0F405.176
CALL GATHER_FIELD(D1(JLAND),LAND,lasize(1), SCH0F405.177
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.178
CALL GATHER_FIELD(D1(JS_SOLARIN),SOLARIN,lasize(1), SCH0F405.179
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.180
CALL GATHER_FIELD(D1(JS_BLUEIN),BLUEIN,lasize(1), SCH0F405.181
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.182
CALL GATHER_FIELD(D1(JS_EVAP),EVAP,lasize(1), SCH0F405.183
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.184
CALL GATHER_FIELD(D1(JS_LONGWAVE),LONGWAVE,lasize(1), SCH0F405.185
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.186
CALL GATHER_FIELD(D1(JS_SENSIBLE),SENSIBLE,lasize(1), SCH0F405.187
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.188
CALL GATHER_FIELD(D1(JS_SNOWLS),SNOWLS,lasize(1), SCH0F405.189
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.190
CALL GATHER_FIELD(D1(JS_SNOWCONV),SNOWCONV,lasize(1), SCH0F405.191
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.192
CALL GATHER_FIELD(D1(JTSTAR),TSTARATM,lasize(1), SCH0F405.193
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.194
CALL GATHER_FIELD(D1(JTSLAB),SLABTEMP,lasize(1), SCH0F405.195
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.196
CALL GATHER_FIELD(D1(JICE_THICKNESS), SCH0F405.197
& HICEATM,lasize(1), SCH0F405.198
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.199
CALL GATHER_FIELD(D1(JSNODEP),HSNOWATM,lasize(1), SCH0F405.200
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.201
CALL GATHER_FIELD(D1(JICE_FRACTION),AICEATM,lasize(1), SCH0F405.202
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.203
CALL GATHER_FIELD(D1(JUICE),UICE,lasize(1), SCH0F405.204
& lasize(2),glsize(1),glsize(2)-1,0,GC_ALL_PROC_GROUP,info) SCH0F405.205
CALL GATHER_FIELD(D1(JVICE),VICE,lasize(1), SCH0F405.206
& lasize(2),glsize(1),glsize(2)-1,0,GC_ALL_PROC_GROUP,info) SCH0F405.207
CALL GATHER_FIELD(D1(JS_SUBLIMZ),SUBLIMA,lasize(1), SCH0F405.208
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.209
CALL GATHER_FIELD(D1(JS_TOPMELTZ),TOPMELTZ,lasize(1), SCH0F405.210
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.211
CALL GATHER_FIELD(D1(JS_BOTMELTZ),BOTMELTZ,lasize(1), SCH0F405.212
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.213
CALL GATHER_FIELD(D1(JTCLIM),TCLIM,lasize(1), SCH0F405.214
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.215
CALL GATHER_FIELD(D1(JHCLIM),HCLIM,lasize(1), SCH0F405.216
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.217
CALL GATHER_FIELD(COS_P_LATITUDE,COS_P_LATITUDE_G,lasize(1), SCH0F405.218
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.219
CALL GATHER_FIELD(COS_U_LATITUDE,COS_U_LATITUDE_G,lasize(1), SCH0F405.220
& lasize(2),glsize(1),glsize(2)-1,0,GC_ALL_PROC_GROUP,info) SCH0F405.221
CALL GATHER_FIELD(SEC_P_LATITUDE,SEC_P_LATITUDE_G,lasize(1), SCH0F405.222
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.223
CALL GATHER_FIELD(SIN_U_LATITUDE,SIN_U_LATITUDE_G,lasize(1), SCH0F405.224
& lasize(2),glsize(1),glsize(2)-1,0,GC_ALL_PROC_GROUP,info) SCH0F405.225
CALL GATHER_FIELD(F3_P,CORIOLIS,lasize(1), SCH0F405.226
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.227
CALL GATHER_FIELD(D1(JS_USEA),UCURRENT,lasize(1), SCH0F405.228
& lasize(2),glsize(1),glsize(2)-1,0,GC_ALL_PROC_GROUP,info) SCH0F405.229
CALL GATHER_FIELD(D1(JS_VSEA),VCURRENT,lasize(1), SCH0F405.230
& lasize(2),glsize(1),glsize(2)-1,0,GC_ALL_PROC_GROUP,info) SCH0F405.231
CALL GATHER_FIELD(D1(JS_WSX),WSX,lasize(1), SCH0F405.232
& lasize(2),glsize(1),glsize(2)-1,0,GC_ALL_PROC_GROUP,info) SCH0F405.233
CALL GATHER_FIELD(D1(JS_WSY),WSY,lasize(1), SCH0F405.234
& lasize(2),glsize(1),glsize(2)-1,0,GC_ALL_PROC_GROUP,info) SCH0F405.235
SCH0F405.236
CALL GATHER_FIELD(REDHC,ADJHCONV,lasize(1), SCH0F405.237
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.238
CALL GATHER_FIELD(GBMICE,HICESLB,lasize(1), SCH0F405.239
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.240
SCH0F405.241
CALL GATHER_FIELD(AREAS,AREAS_G,lasize(1), SCH0F405.242
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.243
C SCH0F405.244
C SCH0F405.245
C Call the Slab Ocean Model (either calibration or non-calibration) SCH0F405.246
C with global variables (variables are distributed over LPG in SCH0F405.247
C the atmosphere code, but the slab model will be called with all SCH0F405.248
C variables on PE 0) SCH0F405.249
C SCH0F405.250
IF (.not. CALIB) THEN SCH0F405.251
CALL GATHER_FIELD(D1(JS_HEATCONV),HEATCONV,lasize(1), SCH0F405.252
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.253
ENDIF SCH0F405.254
SCH0F405.255
SCH0F405.256
IF (mype .eq. 0) THEN SCH0F405.257
SCH0F405.258
CALL SLABCNTL( SCH0F405.259
*CALL ARGOINDX SCH0F405.260
+ WORK_FLD_SIZE,WORK_FLD_SIZEU,glsize(1),glsize(2),LAND,DT,DZ1, SCH0F405.261
+ SOLARIN, BLUEIN, EVAP, LONGWAVE, SENSIBLE, HEATCONV, SCH0F405.262
+ SNOWLS, SNOWCONV, TSTARATM, SLABTEMP, HICEATM, HSNOWATM, SCH0F405.263
+ AICEATM, SUBLIMA, TOPMELTZ, BOTMELTZ, SCH0F405.264
+ UICE,VICE, SCH0F405.265
+ UCURRENT,VCURRENT,WSX,WSY, SCH0F405.266
+ H0,AMXSOUTH,AMXNORTH, SCH0F405.267
+ AICEMIN,HICEMIN, SCH0F405.268
+ TCLIM,HCLIM,CALIB,HICESLB, SCH0F405.269
+ AINC_DYN_G,HINC_DYN_G,HSINC_DYN_G,HINC_DIFF_G, SCH0F405.270
+ HINC_ADV_G,HSINC_ADV_G,AREAS_G, SCH0F405.271
+ AINC_THERM_G,HINC_THERM_G,HSINC_THERM_G,OIFLUX_G, SCH0F405.272
+ PRESSURE_G,PMAX_G,LEADFLUX_G,ATMSFLUX_G,DTADV_G,DTDIFF_G, SCH0F405.273
+ CARYHEAT_G, SCH0F405.274
+ SNOWSLAB_G,SNOWLEAD_G,DTICE_G, SCH0F405.275
+ EDDYDIFF,epsilon,Ah,HCLIMIT,Ah_ice, SCH0F405.276
+ Pstar_ice_strength,kappa_ice_strength,cdw,tol_icav,tol_ifree, SCH0F405.277
+ weight_ifree,nmax_icav,nmax_ifree, SCH0F405.278
+ L_THERM,L_IDYN,L_IDRIF,LGLOBAL,L_SLBADV, SCH0F405.279
+ COS_P_LATITUDE_G,COS_U_LATITUDE_G,SEC_P_LATITUDE_G, SCH0F405.280
+ SIN_U_LATITUDE_G,CORIOLIS,ADJHCONV,wtsfc_G,wtbase_G, SCH0F405.281
+ A_REALHD(1),A_REALHD(2),A_REALHD(3)) SCH0F405.282
SCH0F405.283
ENDIF SCH0F405.284
SCH0F405.285
SCH0F405.286
IF (CALIB) THEN SCH0F405.287
CALL SCATTER_FIELD(STASHWORK(SI(201,40,im_index)),HEATCONV, SCH0F405.288
& lasize(1),lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.289
CALL SWAPBOUNDS(STASHWORK(SI(201,40,im_index)), SCH0F405.290
& lasize(1),lasize(2),Offx,Offy,1) SCH0F405.291
ENDIF SCH0F405.292
SCH0F405.293
SCH0F405.294
C Scatter rest of fields back to LPG SCH0F405.295
SCH0F405.296
CALL SCATTER_FIELD(D1(JTSTAR),TSTARATM,lasize(1), SCH0F405.297
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.298
CALL SCATTER_FIELD(D1(JTSLAB),SLABTEMP,lasize(1), SCH0F405.299
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.300
CALL SCATTER_FIELD(D1(JICE_THICKNESS), SCH0F405.301
& HICEATM,lasize(1), SCH0F405.302
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.303
CALL SCATTER_FIELD(D1(JSNODEP),HSNOWATM,lasize(1), SCH0F405.304
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.305
CALL SCATTER_FIELD(D1(JICE_FRACTION),AICEATM,lasize(1), SCH0F405.306
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.307
CALL SCATTER_FIELD(GBMICE,HICESLB,lasize(1), SCH0F405.308
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.309
CALL SCATTER_FIELD(REDHC,ADJHCONV,lasize(1), SCH0F405.310
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.311
CALL SCATTER_FIELD(wtsfc,wtsfc_G,lasize(1), SCH0F405.312
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.313
CALL SCATTER_FIELD(wtbase,wtbase_G,lasize(1), SCH0F405.314
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.315
CALL SCATTER_FIELD(AINC_THERM,AINC_THERM_G,lasize(1), SCH0F405.316
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.317
CALL SCATTER_FIELD(HINC_THERM,HINC_THERM_G,lasize(1), SCH0F405.318
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.319
CALL SCATTER_FIELD(HSINC_THERM,HSINC_THERM_G,lasize(1), SCH0F405.320
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.321
CALL SCATTER_FIELD(AINC_DYN,AINC_DYN_G,lasize(1), SCH0F405.322
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.323
CALL SCATTER_FIELD(HINC_DYN,HINC_DYN_G,lasize(1), SCH0F405.324
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.325
CALL SCATTER_FIELD(HSINC_DYN,HSINC_DYN_G,lasize(1), SCH0F405.326
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.327
CALL SCATTER_FIELD(HINC_DIFF,HINC_DIFF_G,lasize(1), SCH0F405.328
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.329
CALL SCATTER_FIELD(HINC_ADV,HINC_ADV_G,lasize(1), SCH0F405.330
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.331
CALL SCATTER_FIELD(HSINC_ADV,HSINC_ADV_G,lasize(1), SCH0F405.332
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.333
CALL SCATTER_FIELD(AREAS,AREAS_G,lasize(1), SCH0F405.334
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.335
CALL SCATTER_FIELD(OIFLUX,OIFLUX_G,lasize(1), SCH0F405.336
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.337
CALL SCATTER_FIELD(PRESSURE,PRESSURE_G,lasize(1), SCH0F405.338
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.339
CALL SCATTER_FIELD(PMAX,PMAX_G,lasize(1), SCH0F405.340
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.341
CALL SCATTER_FIELD(ATMSFLUX,ATMSFLUX_G,lasize(1), SCH0F405.342
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.343
CALL SCATTER_FIELD(LEADFLUX,LEADFLUX_G,lasize(1), SCH0F405.344
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.345
CALL SCATTER_FIELD(DTADV,DTADV_G,lasize(1), SCH0F405.346
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.347
CALL SCATTER_FIELD(DTDIFF,DTDIFF_G,lasize(1), SCH0F405.348
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.349
CALL SCATTER_FIELD(CARYHEAT,CARYHEAT_G,lasize(1), SCH0F405.350
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.351
CALL SCATTER_FIELD(SNOWSLAB,SNOWSLAB_G,lasize(1), SCH0F405.352
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.353
CALL SCATTER_FIELD(SNOWLEAD,SNOWLEAD_G,lasize(1), SCH0F405.354
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.355
CALL SCATTER_FIELD(DTICE,DTICE_G,lasize(1), SCH0F405.356
& lasize(2),glsize(1),glsize(2),0,GC_ALL_PROC_GROUP,info) SCH0F405.357
SCH0F405.358
CALL SWAPBOUNDS(D1(JTSTAR),lasize(1),lasize(2),Offx,Offy,1) SCH0F405.359
CALL SWAPBOUNDS(D1(JTSLAB),lasize(1),lasize(2),Offx,Offy,1) SCH0F405.360
CALL SWAPBOUNDS(D1(JICE_THICKNESS),lasize(1),lasize(2), SCH0F405.361
& Offx,Offy,1) SCH0F405.362
CALL SWAPBOUNDS(D1(JSNODEP),lasize(1),lasize(2),Offx,Offy,1) SCH0F405.363
CALL SWAPBOUNDS(D1(JICE_FRACTION),lasize(1),lasize(2), SCH0F405.364
& Offx,Offy,1) SCH0F405.365
CALL SWAPBOUNDS(GBMICE,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.366
CALL SWAPBOUNDS(REDHC,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.367
CALL SWAPBOUNDS(wtsfc,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.368
CALL SWAPBOUNDS(wtbase,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.369
CALL SWAPBOUNDS(AINC_THERM,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.370
CALL SWAPBOUNDS(HINC_THERM,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.371
CALL SWAPBOUNDS(HSINC_THERM,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.372
CALL SWAPBOUNDS(AINC_DYN,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.373
CALL SWAPBOUNDS(HINC_DYN,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.374
CALL SWAPBOUNDS(HSINC_DYN,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.375
CALL SWAPBOUNDS(HINC_DIFF,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.376
CALL SWAPBOUNDS(HINC_ADV,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.377
CALL SWAPBOUNDS(HSINC_ADV,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.378
CALL SWAPBOUNDS(AREAS,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.379
CALL SWAPBOUNDS(OIFLUX,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.380
CALL SWAPBOUNDS(PRESSURE,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.381
CALL SWAPBOUNDS(PMAX,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.382
CALL SWAPBOUNDS(ATMSFLUX,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.383
CALL SWAPBOUNDS(LEADFLUX,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.384
CALL SWAPBOUNDS(DTADV,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.385
CALL SWAPBOUNDS(DTDIFF,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.386
CALL SWAPBOUNDS(CARYHEAT,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.387
CALL SWAPBOUNDS(SNOWSLAB,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.388
CALL SWAPBOUNDS(SNOWLEAD,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.389
CALL SWAPBOUNDS(DTICE,lasize(1),lasize(2),Offx,Offy,1) SCH0F405.390
SCH0F405.391
SCH0F405.392
C copy distributed_variables to stashwork if required SCH0F405.393
C finally call stash SCH0F405.394
SCH0F405.395
*ELSE SCH0F405.396
C SLBSTU1A.123
C SLBSTU1A.124
C Call the Slab Ocean Model (either calibration or non-calibration) SLBSTU1A.125
C SLBSTU1A.126
IF (CALIB) THEN ! Calibration mode: heat convergence diagnosed SLBSTU1A.127
CALL SLABCNTL( SLBSTU1A.128
*CALL ARGOINDX SDR1F404.32
+ P_FIELD,U_FIELD,ROW_LENGTH,P_ROWS,D1(JLAND),DT,DZ1, SLBSTU1A.129
+ D1(JS_SOLARIN), SLBSTU1A.130
+ D1(JS_BLUEIN), SLBSTU1A.131
+ D1(JS_EVAP), SLBSTU1A.132
+ D1(JS_LONGWAVE), SLBSTU1A.133
+ D1(JS_SENSIBLE), SLBSTU1A.134
+ STASHWORK(SI(201,40,im_index)), GDR4F305.147
+ D1(JS_SNOWLS), SLBSTU1A.136
+ D1(JS_SNOWCONV), SLBSTU1A.137
+ D1(JTSTAR), SLBSTU1A.138
+ D1(JTSLAB), SLBSTU1A.139
+ D1(JICE_THICKNESS), SLBSTU1A.140
+ D1(JSNODEP), SLBSTU1A.141
+ D1(JICE_FRACTION), SLBSTU1A.142
+ D1(JS_SUBLIMZ), SLBSTU1A.143
+ D1(JS_TOPMELTZ), SLBSTU1A.144
+ D1(JS_BOTMELTZ), SLBSTU1A.145
+ D1(JUICE),D1(JVICE), SLBSTU1A.146
+ D1(JS_USEA),D1(JS_VSEA), SLBSTU1A.147
+ D1(JS_WSX),D1(JS_WSY), SLBSTU1A.148
+ H0,AMXSOUTH,AMXNORTH, SLBSTU1A.149
+ AICEMIN,HICEMIN, SLBSTU1A.150
+ D1(JTCLIM),D1(JHCLIM),CALIB,GBMICE, SLBSTU1A.151
+ AINC_DYN,HINC_DYN,HSINC_DYN,HINC_DIFF, SLBSTU1A.152
+ HINC_ADV,HSINC_ADV,AREAS, SJC1F400.158
+ AINC_THERM,HINC_THERM,HSINC_THERM,OIFLUX, SLBSTU1A.153
+ PRESSURE,PMAX,LEADFLUX,ATMSFLUX,DTADV,DTDIFF,CARYHEAT, SJC1F400.159
+ SNOWSLAB,SNOWLEAD,DTICE, SJC1F400.160
+ EDDYDIFF,epsilon,Ah,HCLIMIT,Ah_ice, SLBSTU1A.155
+ Pstar_ice_strength,kappa_ice_strength,cdw,tol_icav,tol_ifree, SLBSTU1A.156
+ weight_ifree,nmax_icav,nmax_ifree, SLBSTU1A.157
+ L_THERM,L_IDYN,L_IDRIF,LGLOBAL,L_SLBADV, SLBSTU1A.158
+ COS_P_LATITUDE,COS_U_LATITUDE,SEC_P_LATITUDE, SLBSTU1A.159
+ SIN_U_LATITUDE,F3_P,REDHC,wtsfc,wtbase, SJC1F400.161
+ A_REALHD(1),A_REALHD(2),A_REALHD(3)) SLBSTU1A.161
SLBSTU1A.162
ELSE ! non-calibration mode: heat convergence applied SLBSTU1A.163
C after adjustments due to SLBSTU1A.164
C diffusion and redistribution SLBSTU1A.165
CALL SLABCNTL( SLBSTU1A.166
*CALL ARGOINDX SDR1F404.33
+ P_FIELD,U_FIELD,ROW_LENGTH,P_ROWS,D1(JLAND),DT,DZ1, SLBSTU1A.167
+ D1(JS_SOLARIN), SLBSTU1A.168
+ D1(JS_BLUEIN), SLBSTU1A.169
+ D1(JS_EVAP), SLBSTU1A.170
+ D1(JS_LONGWAVE), SLBSTU1A.171
+ D1(JS_SENSIBLE), SLBSTU1A.172
+ D1(JS_HEATCONV), SLBSTU1A.173
+ D1(JS_SNOWLS), SLBSTU1A.174
+ D1(JS_SNOWCONV), SLBSTU1A.175
+ D1(JTSTAR), SLBSTU1A.176
+ D1(JTSLAB), SLBSTU1A.177
+ D1(JICE_THICKNESS), SLBSTU1A.178
+ D1(JSNODEP), SLBSTU1A.179
+ D1(JICE_FRACTION), SLBSTU1A.180
+ D1(JS_SUBLIMZ), SLBSTU1A.181
+ D1(JS_TOPMELTZ), SLBSTU1A.182
+ D1(JS_BOTMELTZ), SLBSTU1A.183
+ D1(JUICE),D1(JVICE), SLBSTU1A.184
+ D1(JS_USEA),D1(JS_VSEA), SLBSTU1A.185
+ D1(JS_WSX),D1(JS_WSY), SLBSTU1A.186
+ H0,AMXSOUTH,AMXNORTH, SLBSTU1A.187
+ AICEMIN,HICEMIN, SLBSTU1A.188
+ D1(JTCLIM),D1(JHCLIM),CALIB,GBMICE, SLBSTU1A.189
+ AINC_DYN,HINC_DYN,HSINC_DYN,HINC_DIFF, SLBSTU1A.190
+ HINC_ADV,HSINC_ADV,AREAS, SJC1F400.162
+ AINC_THERM,HINC_THERM,HSINC_THERM,OIFLUX, SLBSTU1A.191
+ PRESSURE,PMAX,LEADFLUX,ATMSFLUX,DTADV,DTDIFF,CARYHEAT, SJC1F400.163
+ SNOWSLAB,SNOWLEAD,DTICE, SJC1F400.164
+ EDDYDIFF,epsilon,Ah,HCLIMIT,Ah_ice, SLBSTU1A.193
+ Pstar_ice_strength,kappa_ice_strength,cdw,tol_icav,tol_ifree, SLBSTU1A.194
+ weight_ifree,nmax_icav,nmax_ifree, SLBSTU1A.195
+ L_THERM,L_IDYN,L_IDRIF,LGLOBAL,L_SLBADV, SLBSTU1A.196
+ COS_P_LATITUDE,COS_U_LATITUDE,SEC_P_LATITUDE, SLBSTU1A.197
+ SIN_U_LATITUDE,F3_P,REDHC,wtsfc,wtbase, SJC1F400.165
+ A_REALHD(1),A_REALHD(2),A_REALHD(3)) SLBSTU1A.199
ENDIF SLBSTU1A.200
*ENDIF SCH0F405.397
C SLBSTU1A.201
C SLBSTU1A.202
IF ( SF(203,40) ) THEN SLBSTU1A.203
DO J=1, P_FIELD SLBSTU1A.204
STASHWORK(SI(203,40,im_index)-1+J) = GBMICE(J) GDR4F305.148
ENDDO SLBSTU1A.206
ENDIF SLBSTU1A.207
IF ( SF(202,40) ) THEN SLBSTU1A.208
DO J=1, P_FIELD SLBSTU1A.209
STASHWORK(SI(202,40,im_index)-1+J) = REDHC(J) GDR4F305.149
ENDDO SLBSTU1A.211
ENDIF SLBSTU1A.212
IF ( SF(204,40) ) THEN SLBSTU1A.213
DO J=1, P_FIELD SLBSTU1A.214
STASHWORK(SI(204,40,im_index)-1+J) = AINC_DYN(J) GDR4F305.150
ENDDO SLBSTU1A.216
ENDIF SLBSTU1A.217
IF ( SF(205,40) ) THEN SLBSTU1A.218
DO J=1, P_FIELD SLBSTU1A.219
STASHWORK(SI(205,40,im_index)-1+J) = HINC_DYN(J) GDR4F305.151
ENDDO SLBSTU1A.221
ENDIF SLBSTU1A.222
IF ( SF(206,40) ) THEN SLBSTU1A.223
DO J=1, P_FIELD SLBSTU1A.224
STASHWORK(SI(206,40,im_index)-1+J) = HINC_DIFF(J) GDR4F305.152
ENDDO SLBSTU1A.226
ENDIF SLBSTU1A.227
IF ( SF(207,40) ) THEN SLBSTU1A.228
DO J=1, P_FIELD SLBSTU1A.229
STASHWORK(SI(207,40,im_index)-1+J) = HSINC_DYN(J) GDR4F305.153
ENDDO SLBSTU1A.231
ENDIF SLBSTU1A.232
IF ( SF(208,40) ) THEN SLBSTU1A.233
DO J=1, P_FIELD SLBSTU1A.234
STASHWORK(SI(208,40,im_index)-1+J) = AINC_THERM(J) GDR4F305.154
ENDDO SLBSTU1A.236
ENDIF SLBSTU1A.237
IF ( SF(209,40) ) THEN SLBSTU1A.238
DO J=1, P_FIELD SLBSTU1A.239
STASHWORK(SI(209,40,im_index)-1+J) = HINC_THERM(J) GDR4F305.155
ENDDO SLBSTU1A.241
ENDIF SLBSTU1A.242
IF ( SF(210,40) ) THEN SLBSTU1A.243
DO J=1, P_FIELD SLBSTU1A.244
STASHWORK(SI(210,40,im_index)-1+J) = HSINC_THERM(J) GDR4F305.156
ENDDO SLBSTU1A.246
ENDIF SLBSTU1A.247
IF ( SF(211,40) ) THEN SLBSTU1A.248
DO J=1, P_FIELD SLBSTU1A.249
STASHWORK(SI(211,40,im_index)-1+J) = OIFLUX(J) GDR4F305.157
ENDDO SLBSTU1A.251
ENDIF SLBSTU1A.252
IF ( SF(212,40) ) THEN SLBSTU1A.253
DO J=1, P_FIELD SLBSTU1A.254
STASHWORK(SI(212,40,im_index)-1+J) = PRESSURE(J) GDR4F305.158
ENDDO SLBSTU1A.256
ENDIF SLBSTU1A.257
IF ( SF(213,40) ) THEN SLBSTU1A.258
DO J=1, P_FIELD SLBSTU1A.259
STASHWORK(SI(213,40,im_index)-1+J) = PMAX(J) GDR4F305.159
ENDDO SLBSTU1A.261
ENDIF SLBSTU1A.262
IF ( SF(214,40) ) THEN SJC1F400.166
DO J=1, P_FIELD SJC1F400.167
STASHWORK(SI(214,40,im_index)-1+J) = ATMSFLUX(J) SJC1F400.168
ENDDO SJC1F400.169
ENDIF SJC1F400.170
IF ( SF(215,40) ) THEN SJC1F400.171
DO J=1, P_FIELD SJC1F400.172
STASHWORK(SI(215,40,im_index)-1+J) = LEADFLUX(J) SJC1F400.173
ENDDO SJC1F400.174
ENDIF SJC1F400.175
IF ( SF(216,40) ) THEN SJC1F400.176
DO J=1, P_FIELD SJC1F400.177
STASHWORK(SI(216,40,im_index)-1+J) = wtsfc(j) SJC1F400.178
ENDDO SJC1F400.179
ENDIF SJC1F400.180
IF ( SF(217,40) ) THEN SJC1F400.181
DO J=1, P_FIELD SJC1F400.182
STASHWORK(SI(217,40,im_index)-1+J) = wtbase(j) SJC1F400.183
ENDDO SJC1F400.184
ENDIF SJC1F400.185
IF ( SF(218,40) ) THEN SJC1F400.186
DO J=1, P_FIELD SJC1F400.187
STASHWORK(SI(218,40,im_index)-1+J) = DTADV(J) SJC1F400.188
ENDDO SJC1F400.189
ENDIF SJC1F400.190
IF ( SF(219,40) ) THEN SJC1F400.191
DO J=1, P_FIELD SJC1F400.192
STASHWORK(SI(219,40,im_index)-1+J) = DTDIFF(J) SJC1F400.193
ENDDO SJC1F400.194
ENDIF SJC1F400.195
IF ( SF(220,40) ) THEN SJC1F400.196
DO J=1, P_FIELD SJC1F400.197
STASHWORK(SI(220,40,im_index)-1+J) = CARYHEAT(J) SJC1F400.198
ENDDO SJC1F400.199
ENDIF SJC1F400.200
IF ( SF(221,40) ) THEN SJC1F400.201
DO J=1, P_FIELD SJC1F400.202
STASHWORK(SI(221,40,im_index)-1+J) = DTICE(J) SJC1F400.203
ENDDO SJC1F400.204
ENDIF SJC1F400.205
IF ( SF(222,40) ) THEN SJC1F400.206
DO J=1, P_FIELD SJC1F400.207
STASHWORK(SI(222,40,im_index)-1+J) = SNOWSLAB(J) SJC1F400.208
ENDDO SJC1F400.209
ENDIF SJC1F400.210
IF ( SF(223,40) ) THEN SJC1F400.211
DO J=1, P_FIELD SJC1F400.212
STASHWORK(SI(223,40,im_index)-1+J) = SNOWLEAD(J) SJC1F400.213
ENDDO SJC1F400.214
ENDIF SJC1F400.215
IF ( SF(224,40) ) THEN SJC1F400.216
DO J=1, P_FIELD SJC1F400.217
STASHWORK(SI(224,40,im_index)-1+J) = HINC_ADV(J) SJC1F400.218
ENDDO SJC1F400.219
ENDIF SJC1F400.220
IF ( SF(225,40) ) THEN SJC1F400.221
DO J=1, P_FIELD SJC1F400.222
STASHWORK(SI(225,40,im_index)-1+J) = HSINC_ADV(J) SJC1F400.223
ENDDO SJC1F400.224
ENDIF SJC1F400.225
IF ( SF(226,40) ) THEN SJC1F400.226
DO J=1, P_FIELD SJC1F400.227
STASHWORK(SI(226,40,im_index)-1+J) = AREAS(J) SJC1F400.228
ENDDO SJC1F400.229
ENDIF SJC1F400.230
C SLBSTU1A.263
! Copy Atmosphere prognostics from D1 into Stashwork for GDR8F400.14
! SLAB diagnostics GDR8F400.15
IF ( SF(23,40) ) THEN ! Snow Amounts GDR8F400.16
DO J=1, P_FIELD GDR8F400.17
STASHWORK(SI(23,40,im_index)-1+J) = D1(JSNODEP-1+J) GDR8F400.18
ENDDO GDR8F400.19
ENDIF GDR8F400.20
IF ( SF(24,40) ) THEN ! Surface Temperature GDR8F400.21
DO J=1, P_FIELD GDR8F400.22
STASHWORK(SI(24,40,im_index)-1+J) = D1(JTSTAR-1+J) GDR8F400.23
ENDDO GDR8F400.24
ENDIF GDR8F400.25
IF ( SF(31,40) ) THEN ! Sea Ice Fraction GDR8F400.26
DO J=1, P_FIELD GDR8F400.27
STASHWORK(SI(31,40,im_index)-1+J) = D1(JICE_FRACTION-1+J) GDR8F400.28
ENDDO GDR8F400.29
ENDIF GDR8F400.30
IF ( SF(32,40) ) THEN ! Sea Ice Thickness GDR8F400.31
DO J=1, P_FIELD GDR8F400.32
STASHWORK(SI(32,40,im_index)-1+J) = D1(JICE_THICKNESS-1+J) GDR8F400.33
ENDDO GDR8F400.34
ENDIF GDR8F400.35
C SLBSTU1A.264
IF(ICODE.GT.0) THEN SLBSTU1A.265
RETURN SLBSTU1A.266
ENDIF SLBSTU1A.267
C SLBSTU1A.268
IF(LTIMER) CALL TIMER('STASH',3) SLBSTU1A.269
C SLBSTU1A.270
CALL STASH(slab_im,slab_im,0,D1, GKR0F305.985
*CALL ARGSIZE SLBSTU1A.272
*CALL ARGD1 SLBSTU1A.273
*CALL ARGDUMA SLBSTU1A.274
*CALL ARGDUMO SLBSTU1A.275
*CALL ARGDUMW GKR1F401.264
*CALL ARGSTS SLBSTU1A.276
*CALL ARGPPX GKR0F305.986
& ICODE,CMESSAGE) SLBSTU1A.280
C SLBSTU1A.281
IF(LTIMER) CALL TIMER('STASH',4) SLBSTU1A.282
C SLBSTU1A.283
IF(LTIMER) CALL TIMER('STASH',3) SLBSTU1A.284
C SLBSTU1A.285
CALL STASH(slab_im,slab_im,40,STASHWORK, GKR0F305.987
*CALL ARGSIZE SLBSTU1A.287
*CALL ARGD1 SLBSTU1A.288
*CALL ARGDUMA SLBSTU1A.289
*CALL ARGDUMO SLBSTU1A.290
*CALL ARGDUMW GKR1F401.265
*CALL ARGSTS SLBSTU1A.291
*CALL ARGPPX GKR0F305.988
& ICODE,CMESSAGE) SLBSTU1A.295
C SLBSTU1A.296
IF(LTIMER) CALL TIMER('STASH',4) SLBSTU1A.297
C SLBSTU1A.298
IF(ICODE.GT.0) THEN SLBSTU1A.299
RETURN SLBSTU1A.300
ENDIF SLBSTU1A.301
C SLBSTU1A.302
RETURN SLBSTU1A.303
END SLBSTU1A.304
*ENDIF SLBSTU1A.305