*IF DEF,CONTROL INACCTL1.2
*IF DEF,ATMOS,OR,DEF,OCNASSM ORH6F401.3
C ******************************COPYRIGHT****************************** GTS2F400.4465
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.4466
C GTS2F400.4467
C Use, duplication or disclosure of this code is subject to the GTS2F400.4468
C restrictions as set forth in the contract. GTS2F400.4469
C GTS2F400.4470
C Meteorological Office GTS2F400.4471
C London Road GTS2F400.4472
C BRACKNELL GTS2F400.4473
C Berkshire UK GTS2F400.4474
C RG12 2SZ GTS2F400.4475
C GTS2F400.4476
C If no contract has been raised with this copy of the code, the use, GTS2F400.4477
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.4478
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.4479
C Modelling at the above address. GTS2F400.4480
C ******************************COPYRIGHT****************************** GTS2F400.4481
C GTS2F400.4482
CLL--------------- SUBROUTINE IN_ACCTL -------------------------------- INACCTL1.3
CLL INACCTL1.4
CLL Purpose : Calls the initialisation program for the data assimilation INACCTL1.5
CLL assimilation section (P3) INACCTL1.6
CLL INACCTL1.7
CLL Control routine for CRAY YMP INACCTL1.8
CLL INACCTL1.9
CLL M.Bell <- programmer of some or all of previous code or changes INACCTL1.10
CLL INACCTL1.11
CLL Model Modification history from model version 3.0: INACCTL1.12
CLL version Date INACCTL1.13
CLL 3.1 2/02/93 : added comdeck CHSUNITS to define NUNITS for i/o RS030293.105
CLL 3.2 27/03/93 Dynamic allocation of main data arrays. R. Rawlins @DYALLOC.1207
CLL 3.4 03/08/94 : Pass TR_LEVELS for setting defaults for tracers ARSAF304.341
CLL R Swinbank ARSAF304.342
CLL 3.4 20/06/94 Argument LCAL360 passed to OC_AC_INIT GSS1F304.338
CLL S.J.Swarbrick GSS1F304.339
CLL 3.4 1/8/94 Initialise VAR processing within UM S. Bell VSB1F304.111
CLL 3.5 30/03/95 Sub-model changes : Remove run time constants ADR1F305.93
CLL from Atmos dump headers. D. Robinson. ADR1F305.94
CLL 3.5 16.01.95 Use call to CNTLOCN in CCONTROL to ensure dimensions ORH1F305.5623
CLL are available for Ocean Model arrays. R.Hill. ORH1F305.5624
! 4.1 18/06/96 Changes to cope with changes in STASH addressing GDG0F401.736
! Author D.M. Goddard. GDG0F401.737
CLL 4.1 O_FIXHD(11) removed from call to OC_AC_INIT OFR1F401.64
CLL 4.4 01/06/97 OC_AC_INIT argument list change: OFR6f404.1
CLL OFIXHD(4) replaced by L_OGLOBAL and L_OCYCLIC OFR6f404.2
CLL 4.4 Pass ARGOINDX into OC_AC_INIT OFR1F404.7
CLL INACCTL1.14
CLL Programming standard; U M Documentation Paper No. 3 version 1 INACCTL1.15
CLL dated 15/01/90 INACCTL1.16
CLL INACCTL1.17
CLL System components covered P0 INACCTL1.18
CLL INACCTL1.19
CLL Documentation : UM documentation paper no P0 INACCTL1.20
CLL INACCTL1.21
CLL END INACCTL1.22
C---------------------------------------------------------------------- INACCTL1.23
INACCTL1.24
SUBROUTINE IN_ACCTL( 1,1@DYALLOC.1208
*CALL ARGSIZE 
@DYALLOC.1209
*CALL ARGDUMA @DYALLOC.1210
*CALL ARGDUMO @DYALLOC.1211
*CALL ARGPTRA @DYALLOC.1212
*CALL ARGPTRO @DYALLOC.1213
*CALL ARGOCALL @DYALLOC.1214
*CALL ARGPPX GDG0F401.738
& ICODE,CMESSAGE) @DYALLOC.1215
INACCTL1.26
IMPLICIT NONE INACCTL1.27
INACCTL1.28
C @DYALLOC.1216
INTEGER ICODE ! OUT: Error return code @DYALLOC.1217
CHARACTER*256 CMESSAGE ! OUT: Error return message @DYALLOC.1218
C @DYALLOC.1219
*IF DEF,OCEAN ORH6F401.4
*CALL OARRYSIZ ORH6F401.5
*ENDIF ORH6F401.6
*CALL TYPSIZE @DYALLOC.1220
*CALL TYPDUMA @DYALLOC.1221
*CALL TYPDUMO @DYALLOC.1222
*CALL TYPPTRA @DYALLOC.1223
*CALL TYPPTRO @DYALLOC.1224
*CALL COCNINDX ORH7F402.308
*CALL TYPOCALL @DYALLOC.1225
INACCTL1.32
C* INACCTL1.33
C*L Subroutines called INACCTL1.34
*IF DEF,ATMOS INACCTL1.35
EXTERNAL AC_INIT, Var_UMSetup VSB1F304.112
*ENDIF ATMOS INACCTL1.37
VSB1F304.113
*IF DEF,OCNASSM INACCTL1.38
EXTERNAL OC_AC_INIT INACCTL1.39
*ENDIF OCNASSM INACCTL1.40
C* INACCTL1.41
INACCTL1.42
*CALL CMAXSIZE ADR1F305.95
*CALL CSUBMODL ADR1F305.96
*CALL CPPXREF GDG0F401.739
*CALL PPXLOOK GDG0F401.740
*CALL CTIME INACCTL1.44
*CALL CHSUNITS RS030293.106
*CALL CCONTROL ORH1F305.5625
INACCTL1.45
*IF DEF,ATMOS INACCTL1.46
*CALL CSIZEOBS INACCTL1.48
*CALL CHISTORY GDR3F305.100
*ENDIF ATMOS INACCTL1.50
INACCTL1.51
ORH1F305.5629
*IF DEF,OCNASSM INACCTL1.52
*CALL POCACNST @DYALLOC.1226
*CALL COCGM @DYALLOC.1227
*ENDIF OCNASSM INACCTL1.54
INACCTL1.55
*IF DEF,ATMOS INACCTL1.56
VSB1F304.115
IF(L_AC) THEN VSB1F304.116
VSB1F304.117
CALL AC_INIT (P_LEVELS, Q_LEVELS, BL_LEVELS, TR_LEVELS, GDG0F401.742
& P_ROWS, U_ROWS, ROW_LENGTH, GDG0F401.743
& A_MAX_OBS_SIZE, A_MAX_NO_OBS, GDG0F401.744
& SECS_PER_STEPim(atmos_im), GDG0F401.745
& MODEL_BASIS_TIME(1), MODEL_BASIS_TIME(2), GDG0F401.746
& MODEL_BASIS_TIME(3), MODEL_BASIS_TIME(4), GDG0F401.747
& MODEL_BASIS_TIME(5), GDG0F401.748
& A_REALHD(1), A_REALHD(2), A_REALHD(3), GDG0F401.749
& A_REALHD(4), A_REALHD(5), A_REALHD(6), GDG0F401.750
& A_LEVDEPC(JAK), A_LEVDEPC(JBK), GDG0F401.751
*CALL ARGPPX GDG0F401.752
& ICODE,CMESSAGE) GDG0F401.753
VSB1F304.118
END IF VSB1F304.119
VSB1F304.120
IF(L_3DVAR.OR.L_4DVAR) THEN VSB1F304.121
VSB1F304.122
CALL Var_UMSetup( VSB1F304.123
& P_LEVELS, Q_LEVELS, P_ROWS, ROW_LENGTH, VSB1F304.124
& MODEL_BASIS_TIME(1), VSB1F304.125
& A_REALHD(1), VSB1F304.126
& A_LEVDEPC(JAK), A_LEVDEPC(JBK), VSB1F304.127
*CALL ARGPPX GDG0F401.741
& ICODE,CMESSAGE) VSB1F304.128
VSB1F304.129
END IF VSB1F304.130
INACCTL1.67
*ENDIF ATMOS INACCTL1.68
C INACCTL1.69
*IF DEF,OCNASSM INACCTL1.70
C INACCTL1.71
CALL OC_AC_INIT (ICODE, CMESSAGE, LTIMER, INACCTL1.72
*CALL AOCACSZE @DYALLOC.1228
*CALL ARGOINDX OFR1F404.8
*CALL AOCGM @DYALLOC.1229
*CALL ARGPPX GDG0F401.754
& O_OBS, O_COV, LEN_FIXHD, @DYALLOC.1230
& O_INTHD(6), O_INTHD(7), O_INTHD(8), INACCTL1.74
& O_REALHD(1), O_REALHD(2), INACCTL1.75
& O_REALHD(5), O_REALHD(6), INACCTL1.76
& O_REALHD(3), O_REALHD(4), INACCTL1.77
& O_LEVDEPC, O_ROWDEPC, O_COLDEPC, L_OGLOBAL, L_OCYCLIC, LCAL360 OFR6f404.3
& ) OFR6f404.4
C INACCTL1.79
*ENDIF OCNASSM INACCTL1.80
INACCTL1.81
RETURN INACCTL1.82
END INACCTL1.83
INACCTL1.84
*ENDIF ORH6F401.7
*ENDIF CONTROL INACCTL1.85