*IF DEF,CONTROL,AND,DEF,SLAB SLBSTP1A.2
C ******************************COPYRIGHT****************************** GTS2F400.9145
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9146
C GTS2F400.9147
C Use, duplication or disclosure of this code is subject to the GTS2F400.9148
C restrictions as set forth in the contract. GTS2F400.9149
C GTS2F400.9150
C Meteorological Office GTS2F400.9151
C London Road GTS2F400.9152
C BRACKNELL GTS2F400.9153
C Berkshire UK GTS2F400.9154
C RG12 2SZ GTS2F400.9155
C GTS2F400.9156
C If no contract has been raised with this copy of the code, the use, GTS2F400.9157
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9158
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9159
C Modelling at the above address. GTS2F400.9160
C ******************************COPYRIGHT****************************** GTS2F400.9161
C GTS2F400.9162
CLL Routine: SLABSTEP ------------------------------------------------ SLBSTP1A.3
CLL SLBSTP1A.4
CLL Purpose: To pass correct arguments to top level slab routine SJT1F304.616
CLL SLBSTP1A.6
CLL Called by: U_MODEL SLBSTP1A.7
CLL SLBSTP1A.8
CLL Author: C.A.Senior Date: 14 april 1994 SJT1F304.617
CLL SLBSTP1A.11
CLL Tested under compiler: cft77 SLBSTP1A.12
CLL Tested under OS version: UNICOS 6.1 SLBSTP1A.13
CLL SLBSTP1A.14
CLL Code version no: 1 Date: 14 april 1994 SJT1F304.618
CLL Model Modification history from model version 3.4: SDR1F404.34
CLL version Date SDR1F404.35
!LL 4.4 04/08/97 Call COCNINDX and add ARGOINDX to SLABSTPU SDR1F404.36
!LL argument list. Set up namelist NOCNINDX for SDR1F404.37
!LL COCNINDX variables and print. D. Robinson. SDR1F404.38
!LL SDR1F404.39
!LL 4.5 03/09/98 Slab model (in SLABSTPU) has been modified to be SCH0F405.67
!LL compatible with atmosphere running mpp. Note: the SCH0F405.68
!LL cavitating fluid sea ice dynamics and slab temp. SCH0F405.69
!LL advection bits of code are not used at present and SCH0F405.70
!LL have not been taken into account in this coding. SCH0F405.71
!LL C. D. Hewitt SCH0F405.72
CLL programming standard : UM document 3 version 5 SLBSTP1A.17
CLL system components covered : P40 SLBSTP1A.18
CLL SLBSTP1A.19
CLL External documentation: UM Documentation paper 58 SLBSTP1A.20
CLL SLBSTP1A.21
CLLEND----------------------------------------------------------------- SLBSTP1A.22
C*L Arguments SLBSTP1A.23
SLBSTP1A.24
SUBROUTINE SLABSTEP( 1,1@DYALLOC.2894
*CALL ARGSIZE 
@DYALLOC.2895
*CALL ARGD1 @DYALLOC.2896
*CALL ARGDUMA SJT1F304.619
*CALL ARGDUMO SJT1F304.620
*CALL ARGDUMW GKR1F401.259
*CALL ARGSTS SJT1F304.621
*CALL ARGPTRA @DYALLOC.2897
*CALL ARGPTRO SJT1F304.622
*CALL ARGCONA @DYALLOC.2899
*CALL ARGPPX GKR0F305.989
* ICODE,CMESSAGE) @DYALLOC.2900
SLBSTP1A.26
C @DYALLOC.2901
*CALL CSUBMODL GDR4F305.135
*CALL TYPSIZE @DYALLOC.2902
*CALL TYPD1 @DYALLOC.2903
*CALL TYPDUMA SJT1F304.623
*CALL TYPDUMO SJT1F304.624
*CALL TYPDUMW GKR1F401.260
*CALL TYPSTS SJT1F304.625
*CALL TYPPTRA @DYALLOC.2904
*CALL TYPPTRO SJT1F304.626
*CALL CMAXSIZE @DYALLOC.2906
*CALL TYPCONA @DYALLOC.2907
*CALL PPXLOOK GKR0F305.990
*CALL COCNINDX SDR1F404.40
*IF DEF,MPP SCH0F405.73
*CALL PARVARS SCH0F405.74
*ENDIF SCH0F405.75
SDR1F404.41
NAMELIST /NOCNINDX/ SDR1F404.42
& J_1, J_2, J_3 SDR1F404.43
&, J_JMT, J_JMTM1, J_JMTM2, J_JMTP1 SDR1F404.44
&, JST, JFIN, J_FROM_LOC, J_TO_LOC SDR1F404.45
&, JMT_GLOBAL, JMTM1_GLOBAL, JMTM2_GLOBAL SDR1F404.46
&, JMTP1_GLOBAL, J_OFFSET, O_MYPE, O_EW_HALO, O_NS_HALO SDR1F404.47
&, J_PE_JSTM1, J_PE_JSTM2, J_PE_JFINP1, J_PE_JFINP2 SDR1F404.48
&, O_NPROC SDR1F404.49
&, imout,jmout,J_PE_IND_MED,NMEDLEV SDR1F404.50
SDR1F404.51
SJT1F304.627
INTEGER SLBSTP1A.29
& ICODE ! OUT: Return code : 0 Normal Exit SJT1F304.628
C ! : >0 Error SLBSTP1A.31
SLBSTP1A.32
CHARACTER*(80) SJT1F304.629
& CMESSAGE ! OUT: Error message if return code >0 SJT1F304.630
C SLBSTP1A.52
C External subroutines called SLBSTP1A.53
C SLBSTP1A.54
EXTERNAL SLBSTP1A.55
& SLABSTPU SJT1F304.631
C SLBSTP1A.59
INTEGER im_ident ! Internal model identifier GDR4F305.136
INTEGER im_index ! Internal model index for stash GDR4F305.137
GDR4F305.138
im_ident = slab_im GDR4F305.139
im_index = internal_model_index(im_ident) GDR4F305.140
GDR4F305.141
write (6,*) ' NOCNINDX Namelist is ' SDR1F404.52
write (6,NOCNINDX) SDR1F404.53
SDR1F404.54
C Call top level routine for Slab model SJT1F304.632
C passing across extra arguments to comply with portable model SJT1F304.633
C SLBSTP1A.60
CALL SLABSTPU( SJT1F304.634
*CALL ARGSIZE @DYALLOC.2911
*CALL ARGD1 @DYALLOC.2912
*CALL ARGDUMA @DYALLOC.2913
*CALL ARGDUMO @DYALLOC.2914
*CALL ARGDUMW GKR1F401.261
*CALL ARGSTS @DYALLOC.2915
*CALL ARGPTRA @DYALLOC.2916
*CALL ARGPTRO @DYALLOC.2917
*CALL ARGCONA @DYALLOC.2918
*CALL ARGPPX GKR0F305.991
*CALL ARGOINDX SDR1F404.55
*IF DEF,MPP SCH0F405.76
& glsize(1)*glsize(2), SCH0F405.77
& glsize(1)*(glsize(2)-1), SCH0F405.78
*ENDIF SCH0F405.79
* STASH_MAXLEN(40,im_index),P_FIELD, GDR4F305.142
* ICODE,CMESSAGE) SJT1F304.636
SJT1F304.637
C SLBSTP1A.101
ICODE=0 SJT1F304.638
CMESSAGE=' ' SJT1F304.639
C SLBSTP1A.103
IF(ICODE.GT.0) THEN SLBSTP1A.104
RETURN SLBSTP1A.105
ENDIF SLBSTP1A.106
C SLBSTP1A.107
RETURN SLBSTP1A.108
END SLBSTP1A.109
*ENDIF SLBSTP1A.110