*IF DEF,CONTROL UPANCIL1.2
C ******************************COPYRIGHT****************************** GTS2F400.10837
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10838
C GTS2F400.10839
C Use, duplication or disclosure of this code is subject to the GTS2F400.10840
C restrictions as set forth in the contract. GTS2F400.10841
C GTS2F400.10842
C Meteorological Office GTS2F400.10843
C London Road GTS2F400.10844
C BRACKNELL GTS2F400.10845
C Berkshire UK GTS2F400.10846
C RG12 2SZ GTS2F400.10847
C GTS2F400.10848
C If no contract has been raised with this copy of the code, the use, GTS2F400.10849
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10850
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10851
C Modelling at the above address. GTS2F400.10852
C ******************************COPYRIGHT****************************** GTS2F400.10853
C GTS2F400.10854
CLL Subroutine UP_ANCIL UPANCIL1.3
CLL UPANCIL1.4
CLL CW, SI <- programmer of some or all of previous code or changes UPANCIL1.5
CLL UPANCIL1.6
CLL Model Modification history from model version 3.0: UPANCIL1.7
CLL version Date UPANCIL1.8
CLL 3.1 3/02/93 : added comdeck CHSUNITS to define NUNITS for i/o RS030293.134
CLL 3.2 27/03/93 Dynamic allocation of main data arrays and correct @DYALLOC.3800
CLL uninitialised dimensioning of array D1 in call to @DYALLOC.3801
CLL REPLANCA,REPLANCO. R.Rawlins. @DYALLOC.3802
CLL 3.3 08/02/94 Add BASIS_TIME_DAYS to calls to REPLANCA,REPLANCO TJ080294.330
CLL as part of 32-bit portability change. TCJ TJ080294.331
CLL 3.4 13/06/94 Arguments LANCILA, LANCILO, LCAL360 added GSS1F304.732
CLL LCAL360 passed to REPLANCA/O GSS1F304.733
CLL DEFs ANCILA, ANCILO replaced by LOGICALS GSS1F304.734
CLL LANCILA, LANCILO GSS1F304.735
CLL CALLs to REPLANCA/O now controlled by DEFs ATMOS, GSS1F304.736
CLL OCEAN as well as logical switches LANCILA/O GSS1F304.737
CLL S.J.Swarbrick GSS1F304.738
CLL 3.4 20/07/94 Use ANCIL_REFTIME as reference time to improve GRB1F304.260
CLL time interpolation of ancillaries for both GRB1F304.261
CLL atmosphere and ocean sub-models. R.T.H.Barnes GRB1F304.262
CLL 4.1 17/04/96 Introduce wave sub-model. RTHBarnes. WRB1F401.1121
! 4.1 18/06/96 Changes to cope with changes in STASH addressing GDG0F401.1481
! Author D.M. Goddard. GDG0F401.1482
! 4.4 14/07/97 Pass grid information down to REPLANCA. R A Stratton GRS2F404.221
!LL 4.5 11/09/98 Put DEFs round routines in EXTERNAL. D. Robinson. GHM2F405.11
CLL UPANCIL1.9
CLL Programing standard : UM documentation paper no3, UPANCIL1.10
CLL version no1, dated 15/01/90 UPANCIL1.11
CLL UPANCIL1.12
CLL System components covered : C71 UPANCIL1.13
CLL UPANCIL1.14
CLL System task C7 UPANCIL1.15
CLL UPANCIL1.16
CLL Purpose: The routine is entered when any of the ancillary UPANCIL1.17
CLL fields have to be updated. The list of fields is UPANCIL1.18
CLL searched for update requirements. The position of UPANCIL1.19
CLL the data required is found from the header information UPANCIL1.20
CLL read in from subroutine IN_ANCIL. The data is read in UPANCIL1.21
CLL and updates the existing information. UPANCIL1.22
CLL UPANCIL1.23
CLL Documentation: Unified Model documentation paper no C7. UPANCIL1.24
CLL version no 4, dated 15/06/90 UPANCIL1.25
CLL UPANCIL1.26
CLLEND UPANCIL1.27
UPANCIL1.28
SUBROUTINE UP_ANCIL( 3,4@DYALLOC.3803
*CALL ARGSIZE 
@DYALLOC.3804
*CALL ARGD1 @DYALLOC.3805
*CALL ARGDUMA @DYALLOC.3806
*CALL ARGDUMO @DYALLOC.3807
*CALL ARGDUMW WRB1F401.1122
*CALL ARGPTRA @DYALLOC.3808
*CALL ARGPTRO @DYALLOC.3809
*CALL ARGPTRW WRB1F401.1123
*CALL ARGANC @DYALLOC.3810
& I_AO, GDG0F401.1483
*CALL ARGPPX GDG0F401.1484
& ICODE,CMESSAGE) GDG0F401.1485
UPANCIL1.33
IMPLICIT NONE UPANCIL1.34
UPANCIL1.35
C*L Arguments @DYALLOC.3812
CL @DYALLOC.3813
*CALL TYPSIZE @DYALLOC.3814
*CALL TYPD1 @DYALLOC.3815
*CALL TYPDUMA @DYALLOC.3816
*CALL TYPDUMO @DYALLOC.3817
*CALL TYPDUMW WRB1F401.1124
*CALL TYPPTRA @DYALLOC.3818
*CALL TYPPTRO @DYALLOC.3819
*CALL TYPPTRW WRB1F401.1125
*CALL TYPANC @DYALLOC.3820
INTEGER UPANCIL1.36
& I_AO, ! Sub-model indicator = 1 Atmosphere WRB1F401.1126
C = 2 Ocean UPANCIL1.38
C = 4 Wave WRB1F401.1127
& ICODE ! Return code UPANCIL1.39
UPANCIL1.40
CHARACTER*80 UPANCIL1.41
& CMESSAGE ! Error message UPANCIL1.42
C Local Storage GRB1F304.263
INTEGER ANCIL_REF_DAYS,ANCIL_REF_SECS GRB1F304.264
INTEGER ANCIL_OFFSET_STEPS ! offset of ref. from basis time GRB1F304.265
C* UPANCIL1.43
C Include COMDECKS UPANCIL1.44
*CALL CHSUNITS RS030293.135
*CALL CMAXSIZE GDR3F305.314
*CALL CSUBMODL GDR3F305.315
*CALL CPPXREF GDG0F401.1486
*CALL PPXLOOK GDG0F401.1487
*CALL CCONTROL GDR3F305.316
*CALL CTIME UPANCIL1.49
UPANCIL1.50
! Local Storage GDR3F305.317
INTEGER A_STEPS_PER_HR GDR3F305.318
C*L Subroutines called; UPANCIL1.51
UPANCIL1.52
EXTERNAL TIME2SEC, TIM2STEP GHM2F405.12
*IF DEF,ATMOS GHM2F405.13
& ,REPLANCA GHM2F405.14
*ENDIF GHM2F405.15
*IF DEF,OCEAN GHM2F405.16
& ,REPLANCO GHM2F405.17
*ENDIF GHM2F405.18
*IF DEF,WAVE GHM2F405.19
! & ,REPLANCW ! Yet to be written. GHM2F405.20
*ENDIF GHM2F405.21
UPANCIL1.56
C* UPANCIL1.57
@DYALLOC.3821
ICODE=0 UPANCIL1.61
CMESSAGE=' ' UPANCIL1.62
UPANCIL1.63
CL Convert ancillary reference time to days & secs GRB1F304.267
CALL TIME2SEC(ANCIL_REFTIME(1),ANCIL_REFTIME(2), GRB1F304.268
& ANCIL_REFTIME(3),ANCIL_REFTIME(4), GRB1F304.269
& ANCIL_REFTIME(5),ANCIL_REFTIME(6), GRB1F304.270
& 0,0,ANCIL_REF_DAYS,ANCIL_REF_SECS,LCAL360) GRB1F304.271
GRB1F304.272
CL Compute offset in timesteps of basis time from ancillary ref.time GDR3F305.319
CALL TIM2STEP(BASIS_TIME_DAYS-ANCIL_REF_DAYS, GDR3F305.320
& BASIS_TIME_SECS-ANCIL_REF_SECS, GDR3F305.321
& STEPS_PER_PERIODim(I_AO),SECS_PER_PERIODim(I_AO), GDR3F305.322
& ANCIL_OFFSET_STEPS) GDR3F305.323
GDR3F305.324
IF(I_AO.EQ.1) THEN UPANCIL1.64
! Compute A_STEPS_PER_HR for use in REPLANCA GDR3F305.326
A_STEPS_PER_HR = 3600*STEPS_PER_PERIODim(a_im)/ GDR3F305.327
& SECS_PER_PERIODim(a_im) GDR3F305.328
UPANCIL1.65
*IF DEF,ATMOS GSS1F304.742
!! IF (LANCILim(I_AO)) THEN GDR3F305.325
UPANCIL1.67
CALL REPLANCA(I_YEAR,I_MONTH,I_DAY,I_HOUR,I_MINUTE,I_SECOND, GDG0F401.1488
& I_DAY_NUMBER,ANCIL_REFTIME,ANCIL_OFFSET_STEPS, GDG0F401.1489
& P_FIELD,P_ROWS,U_FIELD,D1,D1(JLAND), GDG0F401.1490
*IF -DEF,RECON GDG0F401.1491
& STEPim(I_AO),LAND_FIELD,A_STEPS_PER_HR, GDG0F401.1492
*ENDIF GDG0F401.1493
& D1(JICE_FRACTION),D1(JTSTAR), GDG0F401.1494
& D1(JTSTAR_ANOM), GDG0F401.1495
& A_REALHD(2),A_REALHD(3), GRS2F404.222
& LEN1_LOOKUP,LEN_FIXHD, GDG0F401.1496
& PP_LEN_INTHD,PP_LEN_REALHD,LEN_TOT, GDG0F401.1497
& FIXHD_ANCILA,INTHD_ANCILA,REALHD_ANCILA, GDG0F401.1498
& LOOKUP_ANCILA,LOOKUP_ANCILA, GDG0F401.1499
& FTNANCILA,LOOKUP_START_ANCILA, GDG0F401.1500
& NANCIL_DATASETSA,NANCIL_LOOKUPSA, GDG0F401.1501
*CALL ARGPPX GDG0F401.1502
& ICODE,CMESSAGE,LCAL360) GDG0F401.1503
UPANCIL1.90
UPANCIL1.91
!! END IF GDR3F305.330
*ENDIF UPANCIL1.92
UPANCIL1.93
ELSE IF(I_AO.EQ.2) THEN UPANCIL1.94
UPANCIL1.95
*IF DEF,OCEAN GSS1F304.746
!! IF (LANCILim(I_AO)) THEN GDR3F305.331
UPANCIL1.97
CALL REPLANCO(I_YEAR,I_MONTH,I_DAY,I_HOUR,I_MINUTE,I_SECOND, GDG0F401.1504
& I_DAY_NUMBER,ANCIL_REFTIME,ANCIL_OFFSET_STEPS, GDG0F401.1505
& IMT,JMT,D1, GDG0F401.1506
*IF -DEF,RECON GDG0F401.1507
& STEPim(I_AO),STEPS_PER_PERIODim(I_AO), GDG0F401.1508
& SECS_PER_PERIODim(I_AO), GDG0F401.1509
*ENDIF GDG0F401.1510
& LEN1_LOOKUP,LEN_FIXHD, GDG0F401.1511
& PP_LEN_INTHD,PP_LEN_REALHD,LEN_TOT, GDG0F401.1512
& FIXHD_ANCILO,INTHD_ANCILO,REALHD_ANCILO, GDG0F401.1513
& LOOKUP_ANCILO,LOOKUP_ANCILO, GDG0F401.1514
& FTNANCILO,LOOKUP_START_ANCILO, GDG0F401.1515
& NANCIL_DATASETSO,NANCIL_LOOKUPSO, GDG0F401.1516
*CALL ARGPPX GDG0F401.1517
*IF DEF,RECON GDG0F401.1518
& IOUNIT, GDG0F401.1519
*ENDIF GDG0F401.1520
& ICODE,CMESSAGE,LCAL360) GDG0F401.1521
UPANCIL1.120
!! END IF GDR3F305.333
*ENDIF UPANCIL1.121
UPANCIL1.122
ELSE IF (I_AO .eq. 4) THEN WRB1F401.1129
*IF DEF,WAVE WRB1F401.1130
WRITE(6,*)' UP_ANCIL; wave sub-model code yet to be written' GIE0F403.665
*ENDIF WRB1F401.1132
END IF UPANCIL1.123
UPANCIL1.124
RETURN UPANCIL1.125
END UPANCIL1.126
UPANCIL1.127
*----------------------------------------------------------------------- UPANCIL1.128
UPANCIL1.129
*ENDIF UPANCIL1.130