*IF DEF,CONTROL,AND,DEF,ATMOS INITPHY1.2
C ******************************COPYRIGHT****************************** GTS2F400.4825
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.4826
C GTS2F400.4827
C Use, duplication or disclosure of this code is subject to the GTS2F400.4828
C restrictions as set forth in the contract. GTS2F400.4829
C GTS2F400.4830
C Meteorological Office GTS2F400.4831
C London Road GTS2F400.4832
C BRACKNELL GTS2F400.4833
C Berkshire UK GTS2F400.4834
C RG12 2SZ GTS2F400.4835
C GTS2F400.4836
C If no contract has been raised with this copy of the code, the use, GTS2F400.4837
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.4838
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.4839
C Modelling at the above address. GTS2F400.4840
C ******************************COPYRIGHT****************************** GTS2F400.4841
C GTS2F400.4842
CLL--------------- SUBROUTINE INITPHYS -------------------------------- INITPHY1.3
CLL INITPHY1.4
CLL Purpose : Calls the initialisation program for the data assimilation INITPHY1.5
CLL assimilation section (P3) INITPHY1.6
CLL Control routine for CRAY YMP INITPHY1.7
CLL INITPHY1.8
CLL T.Johns <- programmer of some or all of previous code or changes INITPHY1.9
CLL INITPHY1.10
CLL Model Modification history from model version 3.0: INITPHY1.11
CLL version Date INITPHY1.12
CLL 3.2 27/03/93 Change INITPHYS for dynamic allocation. Remove @DYALLOC.2054
CLL size parameters no longer needed. R.Rawlins. @DYALLOC.2055
! 4.0 06/07/95 CNTLATM called to allow access to version numbers ADB1F400.24
! to pick up new routines for reading spectral ADB1F400.25
! namelists for version 3A of the SW or LW radiation. ADB1F400.26
! J. M. Edwards ADB1F400.27
! 4.4 02/09/97 Error checking for different sections improved. ADB2F404.587
! Logical flags for aerosols passed down to allow ADB2F404.588
! earlier checking of the spectral data. ADB2F404.589
! J. M. Edwards ADB2F404.590
! 4.5 18/05/98 Logicals for including gases are now passed down ADB1F405.322
! to lower levels to select gases from the ADB1F405.323
! spectral file. ADB1F405.324
! J. M. Edwards ADB1F405.325
! 4.5 April 1998 Pass soot logical to R2_SW_SPECIN. Luke Robinson. ALR3F405.107
CLL INITPHY1.13
CLL Programming standard; U M Documentation Paper No. 3 version 1 INITPHY1.14
CLL dated 15/01/90 INITPHY1.15
CLL INITPHY1.16
CLL System components covered P0 INITPHY1.17
CLL INITPHY1.18
CLL Documentation : UM documentation paper no P0 INITPHY1.19
CLL INITPHY1.20
CLL END INITPHY1.21
INITPHY1.22
INITPHY1.23
SUBROUTINE INITPHYS(ICODE,CMESSAGE) 1,4INITPHY1.24
INITPHY1.25
IMPLICIT NONE INITPHY1.26
INITPHY1.27
INTEGER ICODE ! Return code : 0 Normal exit INITPHY1.28
C ! : >0 Error INITPHY1.29
CHARACTER*80 CMESSAGE ! Error message if ICODE > 0 INITPHY1.30
INITPHY1.31
C* INITPHY1.32
C*L Subroutines called INITPHY1.33
EXTERNAL SWLKIN,LWLKIN INITPHY1.34
& , R2_SW_SPECIN, R2_LW_SPECIN ADB1F400.28
C* INITPHY1.35
*CALL CMAXSIZE 
@DYALLOC.2056
*CALL CCONSTS INITPHY1.38
*CALL CNTLATM ADB1F400.29
*CALL SWOPT3A ADB1F405.326
*CALL SWCOPT3A ADB1F405.327
*CALL LWOPT3A ADB1F405.328
*CALL LWCOPT3A ADB1F405.329
! ADB1F400.30
! ADB1F400.32
! ------------- Shortwave Radiation ------------------------- ADB2F404.591
! ADB2F404.592
IF ( (H_SECT(1).EQ.'01A').OR. ADB2F404.593
& (H_SECT(1).EQ.'01B').OR. ADB2F404.594
& (H_SECT(1).EQ.'02A').OR. ADB2F404.595
& (H_SECT(1).EQ.'02B') ) THEN ADB2F404.596
! ADB2F404.597
CALL SWLKIN(SW_TABLES) ADB1F400.34
! ADB2F404.598
ELSE IF (H_SECT(1).EQ.'03A') THEN ADB2F404.599
! ADB2F404.600
CALL R2_SW_SPECIN(ICODE, CMESSAGE ADB2F404.601
& , L_O2_SW ADB1F405.330
& ,L_CLIMAT_AEROSOL,L_USE_SULPC_DIRECT,L_USE_SOOT_DIRECT) ALR3F405.108
IF (ICODE.NE.0) RETURN ADB2F404.603
! ADB1F400.35
ELSE ADB1F400.36
! ADB1F400.37
ICODE=1 ADB2F404.604
CMESSAGE='Unknown version of SW radiation encountered.' ADB2F404.605
RETURN ADB2F404.606
! ADB2F404.607
ENDIF ADB1F400.39
! ADB1F400.40
! ADB1F400.41
! ------------- Longwave Radiation ------------------------- ADB2F404.608
! ADB1F400.43
IF ( (H_SECT(2).EQ.'01A').OR. ADB2F404.609
& (H_SECT(2).EQ.'01B').OR. ADB2F404.610
& (H_SECT(2).EQ.'01C') ) THEN ADB2F404.611
! ADB2F404.612
CALL LWLKIN(LW_TABLES) ADB1F400.45
! ADB2F404.613
ELSE IF (H_SECT(2).EQ.'03A') THEN ADB2F404.614
! ADB2F404.615
CALL R2_LW_SPECIN(ICODE, CMESSAGE ADB2F404.616
& , L_CH4_LW, L_N2O_LW, L_CFC11_LW, L_CFC12_LW ADB1F405.331
& , L_CFC113_LW, L_HCFC22_LW, L_HFC125_LW, L_HFC134A_LW ADB1F405.332
& ,L_CLIMAT_AEROSOL,L_USE_SULPC_DIRECT,L_USE_SOOT_DIRECT) ALR3F405.109
! ADB1F400.46
ELSE ADB1F400.47
! ADB1F400.48
ICODE=1 ADB2F404.618
CMESSAGE='Unknown version of LW radiation encountered.' ADB2F404.619
RETURN ADB2F404.620
! ADB2F404.621
ENDIF ADB1F400.51
! ADB1F400.52
! ADB1F400.53
! ADB1F400.54
RETURN INITPHY1.42
END INITPHY1.43
*ENDIF INITPHY1.45