*IF DEF,CONTROL SETGRCT1.2
C ******************************COPYRIGHT****************************** GTS2F400.8587
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8588
C GTS2F400.8589
C Use, duplication or disclosure of this code is subject to the GTS2F400.8590
C restrictions as set forth in the contract. GTS2F400.8591
C GTS2F400.8592
C Meteorological Office GTS2F400.8593
C London Road GTS2F400.8594
C BRACKNELL GTS2F400.8595
C Berkshire UK GTS2F400.8596
C RG12 2SZ GTS2F400.8597
C GTS2F400.8598
C If no contract has been raised with this copy of the code, the use, GTS2F400.8599
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8600
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8601
C Modelling at the above address. GTS2F400.8602
C ******************************COPYRIGHT****************************** GTS2F400.8603
C GTS2F400.8604
CLL Routine: SETGRCTL ------------------------------------------------- SETGRCT1.3
CLL SETGRCT1.4
CLL Purpose: Sets timestep group control switches. SETGRCT1.5
CLL SETGRCT1.6
CLL Tested under compiler: cft77 SETGRCT1.7
CLL Tested under OS version: UNICOS 5.1 SETGRCT1.8
CLL SETGRCT1.9
CLL Author: T.C.Johns SETGRCT1.10
CLL SETGRCT1.11
CLL Model Modification history from model version 3.0: SETGRCT1.12
CLL version date SETGRCT1.13
CLL 3.1 8/02/93 : Changed order of comdecks to define NUNITS for RS030293.221
CLL comdeck CCONTROL. RS030293.222
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.174
CLL portability. Author Tracey Smith. TS150793.175
CLL 3.3 02/12/93 Generalise code for submodels and shared data TJ061293.54
CLL partitions in coupled models (eg. SLAB). (TCJ) TJ061293.55
CLL SETGRCT1.14
CLL 3.5 18/04/95 Stage 1 of submodel project: partial generalise GRR2F305.512
CLL to arbitrary submodels. R. Rawlins GRR2F305.513
CLL 4.1 17/04/96 Introduce wave sub-model. RTHBarnes. WRB1F401.736
CLL SETGRCT1.15
CLL Programming standard: UM Doc Paper 3, version 1 (15/1/90) SETGRCT1.16
CLL SETGRCT1.17
CLL Logical components covered: C0 SETGRCT1.18
CLL SETGRCT1.19
CLL Project task: C0 SETGRCT1.20
CLL SETGRCT1.21
CLL External documentation: On-line UM document C0 - The top-level SETGRCT1.22
CLL control system SETGRCT1.23
CLL SETGRCT1.24
CLL ------------------------------------------------------------------- SETGRCT1.25
C*L Interface and arguments: ------------------------------------------ SETGRCT1.26
C SETGRCT1.27
SUBROUTINE SETGRCTL (internal_model,submodel,NGROUP, 2GRR2F305.514
* ICODE,CMESSAGE) GRR2F305.515
C TJ061293.57
IMPLICIT NONE SETGRCT1.29
C TJ061293.58
INTEGER MODEL_DUMP_NUMBER(4) GSS1F305.936
INTEGER internal_model ! OUT - internal model id to run next GRR2F305.516
INTEGER submodel ! OUT - submodel id for dump partition GRR2F305.517
INTEGER NGROUP ! OUT - Number of steps in "group" GRR2F305.518
INTEGER ICODE ! Out - Return code GRR2F305.519
CHARACTER*(80) CMESSAGE ! Out - Error message GRR2F305.520
C SETGRCT1.34
C*---------------------------------------------------------------------- SETGRCT1.35
C Common blocks SETGRCT1.36
C SETGRCT1.37
*CALL CMAXSIZE 
GDR3F305.166
*CALL CSUBMODL GRR2F305.521
*CALL CHSUNITS GDR3F305.167
*CALL CHISTORY RS030293.223
*CALL CCONTROL SETGRCT1.38
*CALL CTIME SETGRCT1.40
C SETGRCT1.41
C Local variables SETGRCT1.42
! Temporary assignment to be replaced by node navigate at later stage GRR2F305.522
INTEGER im ! temporary internal model id for ocean or slab GRR2F305.523
GRR2F305.524
C SETGRCT1.43
CL---------------------------------------------------------------------- SETGRCT1.44
CL 1. Set timestep group control data using history file information, SETGRCT1.45
CL and model step numbers accumulated in CTIME SETGRCT1.46
CL SETGRCT1.47
! GRR2F305.525
! Hardwire settings follow, awaiting replacement by node navigation code GRR2F305.526
! GRR2F305.527
*IF DEF,ATMOS SETGRCT1.49
*IF DEF,OCEAN GRR2F305.528
im=ocean_im GRR2F305.529
*ENDIF Ocean GRR2F305.530
*IF DEF,SLAB GRR2F305.531
im= slab_im GRR2F305.532
*ENDIF Slab GRR2F305.533
*IF DEF,OCEAN,OR,DEF,SLAB SETGRCT1.50
GRR2F305.534
! Check if ocean/slab has completed the same number of groups as atmos GRR2F305.535
IF( (STEPim(atmos_im)/GROUPim(atmos_im) ).EQ. GRR2F305.536
* (STEPim( im)/GROUPim( im) ) ) THEN GRR2F305.537
internal_model=atmos_im GRR2F305.538
ELSE SETGRCT1.57
internal_model= im ! either slab or ocean GRR2F305.539
ENDIF GRR2F305.540
*ELSE Not OCEAN or SLAB GRR2F305.541
internal_model=atmos_im GRR2F305.542
*ENDIF on OCEAN or SLAB GRR2F305.543
GRR2F305.544
*ELSE Not ATMOS GRR2F305.545
*IF DEF,OCEAN TJ061293.63
internal_model=ocean_im GRR2F305.546
*ELSE SETGRCT1.76
*IF DEF,WAVE WRB1F401.737
! This construct is only valid while the wave sub-model in not coupled WRB1F401.738
! to any other sub-model. WRB1F401.739
internal_model=wave_im WRB1F401.740
*ELSE WRB1F401.741
ICODE=1 SETGRCT1.77
CMESSAGE="SETGRCTL : Illegal sub-model type, not ATMOS, OCEAN or WRB1F401.742
& WAVE" WRB1F401.743
*ENDIF on WAVE WRB1F401.744
*ENDIF on OCEAN GRR2F305.547
*ENDIF on ATMOS GRR2F305.548
GRR2F305.549
!! GRR2F305.550
!! 1.1 Determine if a new internal model or submodel for next group. GRR2F305.551
!! {More generalisation needed later to cater for more complex GRR2F305.552
!! coupling cases.} GRR2F305.553
!! GRR2F305.554
GRR2F305.555
IF(STEPim(internal_model).EQ.0 ) THEN ! Initial time, must be new GRR2F305.556
new_im=.true. GRR2F305.557
new_sm=.true. GRR2F305.558
ELSE GRR2F305.559
new_im=.false. GRR2F305.560
new_sm=.false. GRR2F305.561
ENDIF ! Test for initial step GRR2F305.562
GRR2F305.563
IF( N_INTERNAL_MODEL.GT.1) THEN ! ie coupled model GRR2F305.564
! Check if end of group reached GRR2F305.565
IF(mod( GRR2F305.566
* STEPim(internal_model),GROUPim(internal_model)).EQ.0) THEN GRR2F305.567
new_im=.true. ! New internal model next GRR2F305.568
GRR2F305.569
IF( N_SUBMODEL_PARTITION.GT.1) THEN ! ie coupled submodels GRR2F305.570
new_sm=.true. GRR2F305.571
ENDIF ! Coupled submodel GRR2F305.572
GRR2F305.573
ENDIF ! Timestep at end of group GRR2F305.574
ENDIF ! Coupled model GRR2F305.575
GRR2F305.576
!! GRR2F305.577
!! 1.2 Find submodel partition (ie D1/dump) identifier. GRR2F305.578
!! GRR2F305.579
submodel=SUBMODEL_PARTITION_INDEX(internal_model) GRR2F305.580
GRR2F305.581
CL Find group of timesteps for next internal model GRR2F305.582
NGROUP = GROUPim(internal_model) GRR2F305.583
GRR2F305.584
CL Set switches as necessary for control variables held in GRR2F305.585
CL CHISTORY and CCONTROL. {These are held over from 3.4 and GRR2F305.586
CL could probably be removed, to be replaced by more generic items.} GRR2F305.587
LATMOSNEXT=.FALSE. GRR2F305.588
LOCEANNEXT=.FALSE. GRR2F305.589
RUN_OCEAN_FIRST="N" GRR2F305.590
IF(internal_model.EQ.atmos_im) THEN GRR2F305.591
LATMOSNEXT=.TRUE. GRR2F305.592
ELSEIF(internal_model.EQ.ocean_im) THEN GRR2F305.593
LOCEANNEXT=.TRUE. GRR2F305.594
RUN_OCEAN_FIRST="Y" GRR2F305.595
ELSEIF(internal_model.NE.slab_im .and. WRB1F401.745
& internal_model.ne.wave_im) THEN WRB1F401.746
ICODE=1 GRR2F305.597
CMESSAGE= GRR2F305.598
& "SETGRCTL : Illegal sub-model type, not ATMOS, OCEAN or WAVE" WRB1F401.747
write(6,*) CMESSAGE GRR2F305.600
write(6,*) 'illegal internal_model=',internal_model GRR2F305.601
ENDIF GRR2F305.602
GRR2F305.603
c diagnostic write start GRR2F305.604
write(6,*) 'im,sm,ngroup,new_im,new_sm', GRR2F305.605
* internal_model,submodel,ngroup,new_im,new_sm GRR2F305.606
c diagnostic write end GRR2F305.607
C TJ061293.71
RETURN SETGRCT1.82
CL---------------------------------------------------------------------- SETGRCT1.83
END SETGRCT1.84
*ENDIF SETGRCT1.85