*IF DEF,CONTROL,AND,DEF,ATMOS STATMPT1.2
C ******************************COPYRIGHT****************************** GTS2F400.9523
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9524
C GTS2F400.9525
C Use, duplication or disclosure of this code is subject to the GTS2F400.9526
C restrictions as set forth in the contract. GTS2F400.9527
C GTS2F400.9528
C Meteorological Office GTS2F400.9529
C London Road GTS2F400.9530
C BRACKNELL GTS2F400.9531
C Berkshire UK GTS2F400.9532
C RG12 2SZ GTS2F400.9533
C GTS2F400.9534
C If no contract has been raised with this copy of the code, the use, GTS2F400.9535
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9536
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9537
C Modelling at the above address. GTS2F400.9538
C ******************************COPYRIGHT****************************** GTS2F400.9539
C GTS2F400.9540
CLL SUBROUTINE SET_ATM_POINTERS --------------------------------------- STATMPT1.3
CLL STATMPT1.4
CLL Set pointers for primary atmosphere fields STATMPT1.5
CLL Initialisation routine for CRAY YMP STATMPT1.6
CLL STATMPT1.7
CLL MC, CW <- programmer of some or all of previous code or changes STATMPT1.8
CLL STATMPT1.9
CLL Model Modification history from model version 3.0: STATMPT1.10
CLL version Date STATMPT1.11
CLL 3.1 9/02/93 : added comdeck CHSUNITS to define NUNITS for RS030293.236
CLL comdeck CCONTROL. RS030293.237
CLL 3.1 11/03/93 Set JTRACER(1,1) to have a sensible address DR240293.1108
CL even if there are no tracers to remove bounds DR240293.1109
CL checking problems in later routines. R. Rawlins DR240293.1110
CLL 3.2 27/03/93 Dynamic allocation of main data arrays. R. Rawlins @DYALLOC.3413
CLL 3.4 20/01/94 Changes to allow for non-consecutive tracers. AMC1F304.1
CLL M.Carter AMC1F304.2
CLL 3.3 22/11/93 Add aerosol ancillary fields. R T H Barnes. RB221193.95
CLL 3.3 26/10/93 M. Carter. Part of an extensive mod that: MC261093.274
CLL 1.Removes the limit on primary STASH item numbers. MC261093.275
CLL 2.Removes the assumption that (section,item) MC261093.276
CLL defines the sub-model. MC261093.277
CLL 3.Thus allows for user-prognostics. MC261093.278
CLL Remove a_max_variables. MC261093.279
CLL PPINDEX now read from UI in INITCTL. MC261093.280
CLL 3.4 05/09/94 Add murk & user ancillary fields. RTHBarnes. GRB0F304.195
CLL 3.4 18/05/94 J.Thomson add pointers for slab temperature GJT1F304.1
CLL and u and v ice velocities. GJT1F304.2
CLL 3.5 19/05/95 Some pointers for level dependent constants ADR1F305.211
CLL array removed. Sub_model change. D. Robinson ADR1F305.212
CLL 4.0 06/09/95 Set up pointers correctly for SLAB fields. GDR5F400.3
CLL D. Robinson GDR5F400.4
CLL ADR1F305.213
CLL 4.0 26/7/94 R.E. Essery Extra prognostic sea-ice temperature. AJS1F400.178
CLL 4.1 10/1/96 Extra prognostics frozen and unfrozen soil AJS1F401.31
CLL moisture fractions, and canopy conductance AJS1F401.32
CLL plus 2 extra vegetation fields J.Smith AJS1F401.33
CLL 4.1 30/04/96 Add pointers for 6 new variables and 6 new AJS1F401.34
CLL ancillary fields for Sulphur Cycle M Woodage AJS1F401.35
CLL 4.3 18/3/97 Add pointers for HadCM2 sulphate loading patterns AWI1F403.48
CLL William Ingram AWI1F403.49
!LL 4.2 16/08/96 Added MPP PARVARS comdeck, and defined rowdepc APB0F402.121
!LL (filterable wave numbers array) to be globally APB0F402.122
!LL sized. P.Burton APB0F402.123
!LL 4.3 06/03/97 Dimension multi_level land fields by LAND_FIELD ADR2F403.1
!LL for MPP jobs. D. Robinson. ADR2F403.2
!LL 4.4 05/09/97 Add pointer for net energy flux prognostic GSM3F404.5
!LL S.D.Mullerworth GSM3F404.6
!LL 4.4 04/08/97 Generalise JQCF pointer for mixed phase ARB1F404.430
!LL precipitation scheme. RTHBarnes. ARB1F404.431
!LL 4.4 05/08/97 Add pointer for convective cloud amount on AJX0F404.445
!LL model levels (3D CCA) if L_3D_CCA. J.M.Gregory AJX0F404.446
!LL 4.4 10/09/97 Added pointers for snow grain size and snow soot ABX1F404.52
!LL content used in prognostic snow albedo scheme ABX1F404.53
!LL R. Essery ABX1F404.54
!LL 4.4 16/09/97 Add call to NSTYPES and pointers for new ABX1F404.55
!LL vegetation and land surface prognostics. R.A.Betts ABX1F404.56
!LL 4.5 1/07/98 Add pointers for ocean CO2 flux and surface CCN1F405.218
!LL CO2 emissions. C.D.Jones CCN1F405.219
!LL 4.5 04/03/98 Add pointers for NH3 prognostic and NH3 surface AWO1F405.1
!LL emiss for S Cycle M Woodage AWO1F405.2
!LL Also add pointers for 3 soot prognostic variables AWO1F405.3
!LL and 2 soot emiss M Woodage AWO1F405.4
CLL 4.5 15/07/98 Add pointers for new 3D CO2 array. C.D.Jones ACN2F405.1
!LL 4.5 13/05/98 Add pointer for RHcrit. S. Cusack ASK1F405.1
! 4.5 22/10/98 Add pointers for extra multi-layer user GDG2F405.39
! ancillary fields GDG2F405.40
! Author D.M. Goddard GDG2F405.41
! 4.5 29/04/98 Pointer to total soil moisture content to point GDG3F405.1
! to non prognostic space in MOSES. GDG3F405.2
! Author D.M. Goddard GDG3F405.3
CLL 4.5 19/01/98 Replace JVEG_FLDS and JSOIL_FLDS with GDR6F405.63
CLL individual pointers. D. Robinson GDR6F405.64
CLL Programming Standard: Unified Model DP NO. 3, Version 3 STATMPT1.13
CLL STATMPT1.14
CLL Logical task: P0 STATMPT1.15
CLL STATMPT1.16
CLL System Components: C21 (Atmosphere part) STATMPT1.17
CLL STATMPT1.18
CLL Purpose: Sets integer pointers to atmospheric STATMPT1.19
CLL variables from STASHIN addresses. STATMPT1.20
CLL STATMPT1.21
CLL External documentation: UMDP NO. C4 Version NO. 4 STATMPT1.22
CLL STATMPT1.23
CLLEND------------------------------------------------------------- STATMPT1.24
STATMPT1.25
SUBROUTINE SET_ATM_POINTERS( 1@DYALLOC.3414
*CALL ARGSIZE 
@DYALLOC.3415
*CALL ARGDUMA @DYALLOC.3416
*CALL ARGSTS @DYALLOC.3417
*CALL ARGPTRA @DYALLOC.3418
& ICODE,CMESSAGE) @DYALLOC.3419
STATMPT1.27
STATMPT1.28
IMPLICIT NONE STATMPT1.29
STATMPT1.30
CL @DYALLOC.3420
C*L Arguments @DYALLOC.3421
CL @DYALLOC.3422
*CALL CSUBMODL GSS1F305.937
*CALL TYPSIZE @DYALLOC.3423
*CALL NSTYPES ABX1F404.57
*CALL TYPDUMA @DYALLOC.3424
*CALL TYPSTS @DYALLOC.3425
*CALL TYPPTRA @DYALLOC.3426
INTEGER @DYALLOC.3427
& ICODE ! OUT: Error return code @DYALLOC.3428
C @DYALLOC.3429
CHARACTER*80 ARB1F404.432
& CMESSAGE ! OUT: Error return message @DYALLOC.3431
*CALL CHSUNITS RS030293.238
*CALL CCONTROL STATMPT1.31
*CALL CLOOKADD @DYALLOC.3432
*CALL C_MDI STATMPT1.35
*CALL CTRACERA AMC1F304.3
*CALL CSENARIO AWI1F403.50
STATMPT1.36
APB0F402.124
*IF DEF,MPP APB0F402.125
*CALL PARVARS APB0F402.126
*ENDIF APB0F402.127
C local variables STATMPT1.37
STATMPT1.38
INTEGER STATMPT1.39
& IVAR, ! Loop counts AMC1F304.4
& JVAR, ! Loop counts AMC1F304.5
& IFLD, STATMPT1.41
& LEV STATMPT1.42
& ,im_ident ! Internal Model Identifier GDR4F305.292
& ,im_index ! Internal Model Index in Stash arrays GDR4F305.293
& ,Sect_No ! Stash section number GDR4F305.294
& ,A_LEN_DATA_EXTRA ! Total length of data, including ASK1F405.2
! diagnostic variables in D1 ASK1F405.3
GDR4F305.295
! Set to atmosphere internal model GDR4F305.296
im_ident = atmos_im GDR4F305.297
im_index = internal_model_index(im_ident) GDR4F305.298
Sect_No = 0 GDR4F305.299
GDR4F305.300
STATMPT1.43
CL Set pointers for atmospheric primary variables from STASH :- STATMPT1.44
C Set pointers for secondary fields in D1 STATMPT1.45
STATMPT1.46
JPSTAR = SI( 1,Sect_No,im_index) GDR4F305.301
JU(1) = SI( 2,Sect_No,im_index) GDR4F305.304
JV(1) = SI( 3,Sect_No,im_index) GDR4F305.305
JTHETA(1) = SI( 4,Sect_No,im_index) GDR4F305.306
JQ(1) = SI( 10,Sect_No,im_index) GDR4F305.307
A_LEN_DATA_EXTRA = A_LEN_DATA + (P_LEVELS+1)*P_FIELD + 1 ASK1F405.4
JQCL(1) = A_LEN_DATA_EXTRA ASK1F405.5
A_LEN_DATA_EXTRA = A_LEN_DATA_EXTRA + Q_LEVELS * P_FIELD ASK1F405.6
IF (L_LSPICE) THEN ASK1F405.7
JQCF(1) = SI( 12,Sect_No,im_index) ASK1F405.8
ELSE ASK1F405.9
JQCF(1) = A_LEN_DATA_EXTRA ASK1F405.10
A_LEN_DATA_EXTRA = A_LEN_DATA_EXTRA + Q_LEVELS * P_FIELD ASK1F405.11
ENDIF ASK1F405.12
IF (L_RHCPT) THEN ASK1F405.13
JRHC(1) = A_LEN_DATA_EXTRA ASK1F405.14
A_LEN_DATA_EXTRA = A_LEN_DATA_EXTRA + Q_LEVELS * P_FIELD ASK1F405.15
ELSE ASK1F405.16
JRHC(1) = SI( 1,Sect_No,im_index) ASK1F405.17
ENDIF ASK1F405.18
J_DEEP_SOIL_TEMP(1) = SI(20,Sect_No,im_index) GDR4F305.308
IF(LSINGLE_HYDROL) THEN GDG3F405.4
JSMC = SI( 21,Sect_No,im_index) GDG3F405.5
ELSE GDG3F405.6
JSMC = A_LEN_DATA_EXTRA GDG3F405.7
A_LEN_DATA_EXTRA = A_LEN_DATA_EXTRA + P_FIELD GDG3F405.8
JSMCL(1) = SI( 9,Sect_No,im_index) AJS1F401.37
JSTHU(1) = SI( 214,Sect_No,im_index) AJS1F401.38
JSTHF(1) = SI( 215,Sect_No,im_index) AJS1F401.39
ENDIF AJS1F401.40
JCANOPY_WATER = SI(22,Sect_No,im_index) GDR4F305.311
JSNODEP = SI(23,Sect_No,im_index) GDR4F305.312
JTSTAR = SI(24,Sect_No,im_index) GDR4F305.313
JTI = SI(49,Sect_No,im_index) AJS1F400.180
JGS = SI(213,Sect_No,im_index) AJS1F401.41
JTSTAR_ANOM = SI(39,Sect_No,im_index) GDR4F305.314
JZH = SI(25,Sect_No,im_index) GDR4F305.315
JZ0 = SI(26,Sect_No,im_index) GDR4F305.316
JU_SEA = SI(28,Sect_No,im_index) GDR4F305.317
JV_SEA = SI(29,Sect_No,im_index) GDR4F305.318
JLAND = SI(30,Sect_No,im_index) GDR4F305.319
JICE_FRACTION = SI(31,Sect_No,im_index) GDR4F305.320
JICE_THICKNESS = SI(32,Sect_No,im_index) GDR4F305.321
JNET_FLUX=SI(222,Sect_No,im_index) GSM3F404.7
! Orography fields GDR4F305.323
GDR4F305.324
JOROG = SI(33,Sect_No,im_index) GDR4F305.325
JOROG_SD = SI(34,Sect_No,im_index) GDR4F305.326
JOROG_GRAD_XX = SI(35,Sect_No,im_index) GDR4F305.327
JOROG_GRAD_XY = SI(36,Sect_No,im_index) GDR4F305.328
JOROG_GRAD_YY = SI(37,Sect_No,im_index) GDR4F305.329
JOROG_Z0 = SI(19,Sect_No,im_index) ! Roughness len. (old) GDR4F305.330
JOROG_SIL = SI(17,Sect_No,im_index) ! Silhouette area GDR4F305.331
JOROG_HO2 = SI(18,Sect_No,im_index) ! Peak to trough ht. GDR4F305.332
GDR4F305.333
JSAT_SOILW_SUCTION = SI(48,Sect_No,im_index) GDR4F305.334
JLAI = SI(208,Sect_No,im_index) ! Gridbox mean LAI ABX1F404.58
JCANHT = SI(209,Sect_No,im_index) ! Gridbox mean can height ABX1F404.59
JFRAC_TYP = SI(216,Sect_No,im_index) ! Surface type fractions ABX1F404.60
JLAI_PFT = SI(217,Sect_No,im_index) ! Leaf Area Index of PFTs ABX1F404.61
JCANHT_PFT = SI(218,Sect_No,im_index) ! Canopy height of PFTs ABX1F404.62
JDISTURB = SI(219,Sect_No,im_index) ! Veg disturbed fraction ABX1F404.63
JSOIL_ALB = SI(220,Sect_No,im_index) ! Snow-free soil albedo ABX1F404.64
JSNSOOT = SI(221,Sect_No,im_index) ! Snow soot content ABX1F404.65
JSOIL_CARB = SI(223,Sect_No,im_index) ! Soil carbon content ABX1F404.66
JNPP_PFT_ACC = SI(224,Sect_No,im_index) ! Accumulated NPP on PFTs ABX1F404.67
JG_LF_PFT_ACC = SI(225,Sect_No,im_index) ! Accumulated leaf ABX1F404.68
C ! turnover rate on PFTs ABX1F404.69
JG_PHLF_PFT_ACC=SI(226,Sect_No,im_index) ! Accumulat. phenological ABX1F404.70
C ! leaf turnover rate PFTs ABX1F404.71
JRSP_W_PFT_ACC= SI(227,Sect_No,im_index) ! Accum. wood resp PFTs ABX1F404.72
JRSP_S_ACC = SI(228,Sect_No,im_index) ! Accumulated soil resp ABX1F404.73
JCAN_WATER_NIT= SI(229,Sect_No,im_index) ! Canopy water content ABX1F404.74
C ! on non-ice tiles ABX1F404.75
JCATCH_NIT = SI(230,Sect_No,im_index) ! Canopy capacity on ABX1F404.76
C ! non-ice tiles ABX1F404.77
JRGRAIN = SI(231,Sect_No,im_index) ! Snow grain size ABX1F404.78
JTSNOW = SI(232,Sect_No,im_index) ! Snow surface layer temp ABX1F404.79
JTSTAR_TYP = SI(233,Sect_No,im_index) ! Tiled surface temp ABX1F404.80
JZ0_TYP = SI(234,Sect_No,im_index) ! Tiled surface roughness ABX1F404.81
JOZONE(1) = SI(60,Sect_No,im_index) GDR4F305.335
IF (L_3D_CCA) THEN AJX0F404.447
JCCA(1) = SI(211,Sect_No,im_index) AJX0F404.448
DO LEV=2,N_CCA_LEV AJX0F404.449
JCCA(LEV)=JCCA(LEV-1)+P_FIELD AJX0F404.450
ENDDO AJX0F404.451
ELSE AJX0F404.452
JCCA(1) = SI(13,Sect_No,im_index) AJX0F404.453
ENDIF AJX0F404.454
JCCB = SI(14,Sect_No,im_index) GDR4F305.337
JCCT = SI(15,Sect_No,im_index) GDR4F305.338
JCCLWP = SI(16,Sect_No,im_index) GDR4F305.339
GDR4F305.340
! Add sources and aerosol ancillaries GDR4F305.341
GDR4F305.342
JMURK_SOURCE(1) = SI(57,Sect_No,im_index) ! Murk source GDR4F305.343
JSO2_EM = SI(58,Sect_No,im_index) ! Sulphur dioxide emiss. GDR4F305.344
JDMS_EM = SI(59,Sect_No,im_index) ! Dimethyl sulphide emiss. GDR4F305.345
JMURK(1) = SI(90,Sect_No,im_index) ! Murk concentration GDR4F305.346
JSO4(1) = SI(88,Sect_No,im_index) ! Sulphate aerosol GDR4F305.347
JH2SO4(1) = SI(87,Sect_No,im_index) ! Sulphuric acid aerosol GDR4F305.348
JSOOT(1) = SI(85,Sect_No,im_index) ! Soot GDR4F305.349
! Add for Sulphur Cycle AJS1F401.44
JSO2(1) =SI(101,Sect_No,im_index) !Sulphur dioxide gas AJS1F401.45
JDMS(1) =SI(102,Sect_No,im_index) !Dimethyl sulphide gas AJS1F401.46
JSO4_AITKEN(1)=SI(103,Sect_No,im_index) !Aitken mode SO4 aerosol AJS1F401.47
JSO4_ACCU(1) =SI(104,Sect_No,im_index) !Accumulation mode SO4 aer AJS1F401.48
JSO4_DISS(1) =SI(105,Sect_No,im_index) !Dissolved SO4 aerosol AJS1F401.49
JH2O2(1) =SI(106,Sect_No,im_index) !Hydrogen peroxide mmr AJS1F401.50
JNH3(1) =SI(107,Sect_No,im_index) !Ammonia gas AWO1F405.5
JSOOT_NEW(1) =SI(108,Sect_No,im_index) !Fresh soot AWO1F405.6
JSOOT_AGD(1) =SI(109,Sect_No,im_index) !Aged soot AWO1F405.7
JSOOT_CLD(1) =SI(110,Sect_No,im_index) !Soot in cloud AWO1F405.8
JSO2_NATEM(1) =SI(121,Sect_No,im_index) !Natural SO2 emissions AJS1F401.51
JOH(1) =SI(122,Sect_No,im_index) !OH 3_D ancillary AJS1F401.52
JHO2(1) =SI(123,Sect_No,im_index) !HO2 3_D ancillary AJS1F401.53
JH2O2_LIMIT(1)=SI(124,Sect_No,im_index) !H2O2 LIMIT 3_D ancillary AJS1F401.54
JO3_CHEM(1) =SI(125,Sect_No,im_index) !O3 for chemistry 3_D anc AJS1F401.55
JSO2_HILEM =SI(126,Sect_No,im_index) !High level SO2 emissions AJS1F401.56
JNH3_EM =SI(127,Sect_No,im_index) !Ammonia surface emiss AWO1F405.9
JSOOT_EM =SI(128,Sect_No,im_index) !Fresh soot surf emiss AWO1F405.10
JSOOT_HILEM =SI(129,Sect_No,im_index) !Fresh soot high emiss AWO1F405.11
! HadCM2 sulphate loading patterns AWI1F403.51
JHadCM2_SO4(1)=SI(160,Sect_No,im_index) AWI1F403.52
DO LEV=2, NSULPAT AWI1F403.53
JHadCM2_SO4(LEV)=JHadCM2_SO4(LEV-1)+P_FIELD AWI1F403.54
ENDDO AWI1F403.55
! Add for Carbon cycle CCN1F405.220
J_CO2FLUX = SI(250,Sect_No,im_index) CCN1F405.221
J_CO2_EMITS = SI(251,Sect_No,im_index) CCN1F405.222
JCO2(1) = SI(252,Sect_No,im_index) CCN1F405.223
GDR4F305.350
! Add user ancillaries GDR4F305.351
GDR4F305.352
JUSER_ANC1 = SI(301,Sect_No,im_index) GDR4F305.353
JUSER_ANC2 = SI(302,Sect_No,im_index) GDR4F305.354
JUSER_ANC3 = SI(303,Sect_No,im_index) GDR4F305.355
JUSER_ANC4 = SI(304,Sect_No,im_index) GDR4F305.356
JUSER_ANC5 = SI(305,Sect_No,im_index) GDR4F305.357
JUSER_ANC6 = SI(306,Sect_No,im_index) GDR4F305.358
JUSER_ANC7 = SI(307,Sect_No,im_index) GDR4F305.359
JUSER_ANC8 = SI(308,Sect_No,im_index) GDR4F305.360
JUSER_ANC9 = SI(309,Sect_No,im_index) GDR4F305.361
JUSER_ANC10 = SI(310,Sect_No,im_index) GDR4F305.362
JUSER_ANC11 = SI(311,Sect_No,im_index) GDR4F305.363
JUSER_ANC12 = SI(312,Sect_No,im_index) GDR4F305.364
JUSER_ANC13 = SI(313,Sect_No,im_index) GDR4F305.365
JUSER_ANC14 = SI(314,Sect_No,im_index) GDR4F305.366
JUSER_ANC15 = SI(315,Sect_No,im_index) GDR4F305.367
JUSER_ANC16 = SI(316,Sect_No,im_index) GDR4F305.368
JUSER_ANC17 = SI(317,Sect_No,im_index) GDR4F305.369
JUSER_ANC18 = SI(318,Sect_No,im_index) GDR4F305.370
JUSER_ANC19 = SI(319,Sect_No,im_index) GDR4F305.371
JUSER_ANC20 = SI(320,Sect_No,im_index) GDR4F305.372
JUSER_MULT1(1) = SI(321,Sect_No,im_index) GDG2F405.42
JUSER_MULT2(1) = SI(322,Sect_No,im_index) GDG2F405.43
JUSER_MULT3(1) = SI(323,Sect_No,im_index) GDG2F405.44
JUSER_MULT4(1) = SI(324,Sect_No,im_index) GDG2F405.45
JUSER_MULT5(1) = SI(325,Sect_No,im_index) GDG2F405.46
JUSER_MULT6(1) = SI(326,Sect_No,im_index) GDG2F405.47
JUSER_MULT7(1) = SI(327,Sect_No,im_index) GDG2F405.48
JUSER_MULT8(1) = SI(328,Sect_No,im_index) GDG2F405.49
JUSER_MULT9(1) = SI(329,Sect_No,im_index) GDG2F405.50
JUSER_MULT10(1) = SI(330,Sect_No,im_index) GDG2F405.51
JUSER_MULT11(1) = SI(331,Sect_No,im_index) GDG2F405.52
JUSER_MULT12(1) = SI(332,Sect_No,im_index) GDG2F405.53
JUSER_MULT13(1) = SI(333,Sect_No,im_index) GDG2F405.54
JUSER_MULT14(1) = SI(334,Sect_No,im_index) GDG2F405.55
JUSER_MULT15(1) = SI(335,Sect_No,im_index) GDG2F405.56
JUSER_MULT16(1) = SI(336,Sect_No,im_index) GDG2F405.57
JUSER_MULT17(1) = SI(337,Sect_No,im_index) GDG2F405.58
JUSER_MULT18(1) = SI(338,Sect_No,im_index) GDG2F405.59
JUSER_MULT19(1) = SI(339,Sect_No,im_index) GDG2F405.60
JUSER_MULT20(1) = SI(340,Sect_No,im_index) GDG2F405.61
GRB0F304.231
JP_EXNER(1)=A_LEN_DATA+1 STATMPT1.80
STATMPT1.81
DO LEV=2,P_LEVELS STATMPT1.82
JU(LEV)=JU(LEV-1)+U_FIELD STATMPT1.83
JV(LEV)=JV(LEV-1)+U_FIELD STATMPT1.84
JTHETA(LEV)=JTHETA(LEV-1)+P_FIELD STATMPT1.85
JP_EXNER(LEV)=JP_EXNER(LEV-1)+P_FIELD STATMPT1.86
JMURK_SOURCE(LEV) = JMURK_SOURCE(LEV-1)+P_FIELD GRB0F304.232
JMURK(LEV) = JMURK(LEV-1)+P_FIELD GRB0F304.233
C For Sulphur Cycle variables AJS1F401.57
JSO2(LEV)=JSO2(LEV-1)+P_FIELD AJS1F401.58
JDMS(LEV)=JDMS(LEV-1)+P_FIELD AJS1F401.59
JSO4_AITKEN(LEV)=JSO4_AITKEN(LEV-1)+P_FIELD AJS1F401.60
JSO4_ACCU(LEV)=JSO4_ACCU(LEV-1)+P_FIELD AJS1F401.61
JSO4_DISS(LEV)=JSO4_DISS(LEV-1)+P_FIELD AJS1F401.62
JH2O2(LEV)=JH2O2(LEV-1)+P_FIELD AJS1F401.63
JSO2_NATEM(LEV)=JSO2_NATEM(LEV-1)+P_FIELD AJS1F401.64
JOH(LEV) = JOH(LEV-1)+P_FIELD AJS1F401.65
JHO2(LEV) = JHO2(LEV-1)+P_FIELD AJS1F401.66
JNH3(LEV) = JNH3(LEV-1)+P_FIELD AWO1F405.12
JSOOT_NEW(LEV) = JSOOT_NEW(LEV-1)+P_FIELD AWO1F405.13
JSOOT_AGD(LEV) = JSOOT_AGD(LEV-1)+P_FIELD AWO1F405.14
JSOOT_CLD(LEV) = JSOOT_CLD(LEV-1)+P_FIELD AWO1F405.15
AWO1F405.16
AWO1F405.17
JH2O2_LIMIT(LEV)=JH2O2_LIMIT(LEV-1)+P_FIELD AJS1F401.67
JO3_CHEM(LEV)=JO3_CHEM(LEV-1)+P_FIELD AJS1F401.68
C For Carbon Cycle variables ACN2F405.2
JCO2(LEV)=JCO2(LEV-1)+P_FIELD ACN2F405.3
END DO RB221193.102
C Set for multi-level aerosols RB221193.103
DO LEV=2,TR_LEVELS RB221193.104
JSO4(LEV)=JSO4(LEV-1)+P_FIELD RB221193.105
JH2SO4(LEV)=JH2SO4(LEV-1)+P_FIELD RB221193.106
JSOOT(LEV)=JSOOT(LEV-1)+P_FIELD RB221193.107
END DO GRB0F304.234
C Set for multi-level user ancillaries GRB0F304.235
DO LEV=2,P_LEVELS GRB0F304.236
JUSER_MULT1(LEV) = JUSER_MULT1(LEV-1)+P_FIELD GDG2F405.62
JUSER_MULT2(LEV) = JUSER_MULT2(LEV-1)+P_FIELD GDG2F405.63
JUSER_MULT3(LEV) = JUSER_MULT3(LEV-1)+P_FIELD GDG2F405.64
JUSER_MULT4(LEV) = JUSER_MULT4(LEV-1)+P_FIELD GDG2F405.65
JUSER_MULT5(LEV) = JUSER_MULT5(LEV-1)+P_FIELD GDG2F405.66
JUSER_MULT6(LEV) = JUSER_MULT6(LEV-1)+P_FIELD GDG2F405.67
JUSER_MULT7(LEV) = JUSER_MULT7(LEV-1)+P_FIELD GDG2F405.68
JUSER_MULT8(LEV) = JUSER_MULT8(LEV-1)+P_FIELD GDG2F405.69
JUSER_MULT9(LEV) = JUSER_MULT9(LEV-1)+P_FIELD GDG2F405.70
JUSER_MULT10(LEV) = JUSER_MULT10(LEV-1)+P_FIELD GDG2F405.71
JUSER_MULT11(LEV) = JUSER_MULT11(LEV-1)+P_FIELD GDG2F405.72
JUSER_MULT12(LEV) = JUSER_MULT12(LEV-1)+P_FIELD GDG2F405.73
JUSER_MULT13(LEV) = JUSER_MULT13(LEV-1)+P_FIELD GDG2F405.74
JUSER_MULT14(LEV) = JUSER_MULT14(LEV-1)+P_FIELD GDG2F405.75
JUSER_MULT15(LEV) = JUSER_MULT15(LEV-1)+P_FIELD GDG2F405.76
JUSER_MULT16(LEV) = JUSER_MULT16(LEV-1)+P_FIELD GDG2F405.77
JUSER_MULT17(LEV) = JUSER_MULT17(LEV-1)+P_FIELD GDG2F405.78
JUSER_MULT18(LEV) = JUSER_MULT18(LEV-1)+P_FIELD GDG2F405.79
JUSER_MULT19(LEV) = JUSER_MULT19(LEV-1)+P_FIELD GDG2F405.80
JUSER_MULT20(LEV) = JUSER_MULT20(LEV-1)+P_FIELD GDG2F405.81
END DO STATMPT1.87
STATMPT1.88
JP_EXNER(P_LEVELS+1)=JP_EXNER(P_LEVELS)+P_FIELD STATMPT1.89
DO LEV=2,ST_LEVELS AJS1F401.69
J_DEEP_SOIL_TEMP(LEV)=J_DEEP_SOIL_TEMP(LEV-1)+LAND_FIELD STATMPT1.91
END DO STATMPT1.92
IF (.NOT.LSINGLE_HYDROL) THEN AJS1F401.70
DO LEV=2,SM_LEVELS AJS1F401.71
JSMCL(LEV)=JSMCL(LEV-1)+LAND_FIELD STATMPT1.95
ENDDO AJS1F401.72
ENDIF AJS1F401.73
STATMPT1.97
IF (LMOSES) THEN AJS1F401.74
DO LEV=2,SM_LEVELS AJS1F401.75
JSTHU(LEV)=JSTHU(LEV-1)+LAND_FIELD AJS1F401.77
ENDDO AJS1F401.82
ENDIF AJS1F401.83
AJS1F401.84
IF (LMOSES) THEN AJS1F401.85
DO LEV=2,SM_LEVELS AJS1F401.86
JSTHF(LEV)=JSTHF(LEV-1)+LAND_FIELD AJS1F401.88
END DO AJS1F401.93
ENDIF AJS1F401.94
AJS1F401.95
! Soil fields GDR6F405.65
JVOL_SMC_WILT = SI(40, Sect_No, im_index) GDR6F405.66
JVOL_SMC_CRIT = SI(41, Sect_No, im_index) GDR6F405.67
JVOL_SMC_FCAP = SI(42, Sect_No, im_index) GDR6F405.68
JVOL_SMC_SAT = SI(43, Sect_No, im_index) GDR6F405.69
JSAT_SOIL_COND = SI(44, Sect_No, im_index) GDR6F405.70
JEAGLE_EXP = SI(45, Sect_No, im_index) GDR6F405.71
JTHERM_CAP = SI(46, Sect_No, im_index) GDR6F405.72
JTHERM_COND = SI(47, Sect_No, im_index) GDR6F405.73
JCLAPP_HORN = SI(207, Sect_No, im_index) GDR6F405.74
STATMPT1.101
! Vegetation Fields GDR6F405.75
JVEG_FRAC = SI(50, Sect_No, im_index) GDR6F405.76
JROOT_DEPTH = SI(51, Sect_No, im_index) GDR6F405.77
JSFA = SI(52, Sect_No, im_index) GDR6F405.78
JMDSA = SI(53, Sect_No, im_index) GDR6F405.79
JSURF_RESIST = SI(54, Sect_No, im_index) GDR6F405.80
JSURF_CAP = SI(55, Sect_No, im_index) GDR6F405.81
JINFILT = SI(56, Sect_No, im_index) GDR6F405.82
STATMPT1.105
DO LEV=2,Q_LEVELS STATMPT1.108
JQ(LEV)=JQ(LEV-1)+P_FIELD STATMPT1.109
JQCL(LEV)=JQCL(LEV-1)+P_FIELD STATMPT1.110
JQCF(LEV)=JQCF(LEV-1)+P_FIELD STATMPT1.111
JRHC(LEV)=JRHC(LEV-1)+P_FIELD ASK1F405.19
END DO STATMPT1.112
STATMPT1.113
JVAR=0 ! JVAR+1 is the current tracer to be found AMC1F304.6
IF (TR_VARS.GT.0) THEN AMC1F304.7
DO IVAR=A_TRACER_FIRST,A_TRACER_LAST AMC1F304.8
IF(SI(IVAR,Sect_No,im_index).NE.1) THEN ! tracer in use GDR4F305.383
JVAR=JVAR+1 AMC1F304.10
JTRACER(1,JVAR) = SI(IVAR,Sect_No,im_index) GDR4F305.384
DO LEV=2,TR_LEVELS AMC1F304.12
JTRACER(LEV,JVAR)=JTRACER(LEV-1,JVAR)+P_FIELD AMC1F304.13
END DO AMC1F304.14
A_TR_INDEX(IVAR-A_TRACER_FIRST+1)=JVAR AMC1F304.15
END IF AMC1F304.16
END DO STATMPT1.120
ELSE DR240293.1111
JTRACER(1,1)=1 ! Ensure a sensible address even if no tracers DR240293.1112
ENDIF STATMPT1.121
IF(JVAR.NE.TR_VARS) THEN AMC1F304.17
WRITE(6,*) 'STATMPT: TR_VARS and SI are inconsistent' AMC1F304.18
WRITE(6,*) 'TR_VARS=',TR_VARS,' . But, SI implies :',JVAR AMC1F304.19
CMESSAGE= 'STATMPT: TR_VARS and SI inconsistent, see output' AMC1F304.20
ICODE=100 AMC1F304.21
GOTO 9999 ! error return AMC1F304.22
END IF AMC1F304.23
STATMPT1.122
JRIM = SI(97,Sect_No,im_index) GDR4F305.385
JRIM_TENDENCY = SI(96,Sect_No,im_index) GDR4F305.386
STATMPT1.125
STATMPT1.140
C CHECK FOR WHETHER OZONE IS HELD AS ZONAL MEAN OR THREE-DIM FIELD STATMPT1.141
STATMPT1.142
LEXPAND_OZONE=.FALSE. STATMPT1.143
STATMPT1.144
IF (A_LOOKUP(LBNPT,PPINDEX(60,im_index)).EQ.1) THEN GDR4F305.387
LEXPAND_OZONE = .TRUE. GDR4F305.388
ENDIF GDR4F305.389
DO LEV=2,OZONE_LEVELS STATMPT1.146
IF(LEXPAND_OZONE) THEN STATMPT1.147
JOZONE(LEV)=JOZONE(LEV-1)+P_ROWS STATMPT1.148
ELSE STATMPT1.149
JOZONE(LEV)=JOZONE(LEV-1)+P_FIELD STATMPT1.150
END IF STATMPT1.151
END DO STATMPT1.152
STATMPT1.153
C Set pointers to level dependent constants for atmosphere STATMPT1.154
STATMPT1.155
JAK=1 STATMPT1.156
JBK=JAK+P_LEVELS STATMPT1.157
JDELTA_AK=JBK+P_LEVELS STATMPT1.158
JDELTA_BK=JDELTA_AK+P_LEVELS STATMPT1.159
JTHETA_REF=JDELTA_BK+P_LEVELS STATMPT1.160
ADR1F305.214
! Pointers JK1,JK2,JEXPK1,JEXPK2,JKDA,JKDF,JRHCRIT removed ADR1F305.215
ADR1F305.216
JSOIL_THICKNESS = JTHETA_REF+P_LEVELS ADR1F305.217
STATMPT1.169
C Set pointers to row dependent constants for atmosphere STATMPT1.170
STATMPT1.171
JFILTER_WAVE_NUMBER_P_ROWS=1 STATMPT1.172
*IF -DEF,MPP APB0F402.128
JFILTER_WAVE_NUMBER_U_ROWS=JFILTER_WAVE_NUMBER_P_ROWS+P_ROWS STATMPT1.173
JNSWEEP=JFILTER_WAVE_NUMBER_U_ROWS+P_ROWS STATMPT1.174
*ELSE APB0F402.129
JFILTER_WAVE_NUMBER_U_ROWS=JFILTER_WAVE_NUMBER_P_ROWS+glsize(2) APB0F402.130
JNSWEEP=JFILTER_WAVE_NUMBER_U_ROWS+glsize(2) APB0F402.131
*ENDIF APB0F402.132
GDR5F400.5
*IF DEF,SLAB GDR5F400.6
! Set up pointers for slab model fields GDR5F400.7
im_ident = slab_im GDR5F400.8
im_index = internal_model_index(im_ident) GDR5F400.9
GDR5F400.10
JTCLIM = SI(178,Sect_No,im_index) ! Ref SST GDR5F400.11
JHCLIM = SI(179,Sect_No,im_index) ! Clim SeaIce Depth GDR5F400.12
JTSLAB = SI(210,Sect_No,im_index) ! Slab temperature GDR5F400.13
JUICE = SI(211,Sect_No,im_index) ! u ice velocity GDR5F400.14
JVICE = SI(212,Sect_No,im_index) ! v ice velocity GDR5F400.15
*ENDIF GDR5F400.16
WRITE(6,1000) STATMPT1.176
1000 FORMAT('0--------------- PRIMARY VARIABLES ---------------') STATMPT1.177
WRITE(6,1010) JPSTAR STATMPT1.178
1010 FORMAT(' PSTAR AT DUMP STORE INDEX',I8) STATMPT1.179
WRITE(6,1012) JU(1) STATMPT1.180
1012 FORMAT(' U AT DUMP STORE INDEX',I8) STATMPT1.181
WRITE(6,1014) JV(1) STATMPT1.182
1014 FORMAT(' V AT DUMP STORE INDEX',I8) STATMPT1.183
WRITE(6,1016) JTHETA(1) STATMPT1.184
1016 FORMAT(' THETA AT DUMP STORE INDEX',I8) STATMPT1.185
WRITE(6,1018) JQ(1) STATMPT1.186
1018 FORMAT(' HMR AT DUMP STORE INDEX',I8) STATMPT1.187
IF (L_LSPICE) THEN ARB1F404.437
WRITE(6,1020) JQCF(1) ARB1F404.438
1020 FORMAT(' QCF AT DUMP STORE INDEX',I8) ARB1F404.439
END IF ARB1F404.440
STATMPT1.188
9999 CONTINUE ! ERROR GOTO point. AMC1F304.24
RETURN STATMPT1.190
END STATMPT1.191
STATMPT1.192
*ENDIF STATMPT1.193