*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.35 *IF DEF,A01_3A,OR,DEF,A02_3A INTFX3A.2 C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13348 C GTS2F400.13349 C Use, duplication or disclosure of this code is subject to the GTS2F400.13350 C restrictions as set forth in the contract. GTS2F400.13351 C GTS2F400.13352 C Meteorological Office GTS2F400.13353 C London Road GTS2F400.13354 C BRACKNELL GTS2F400.13355 C Berkshire UK GTS2F400.13356 C RG12 2SZ GTS2F400.13357 C GTS2F400.13358 C If no contract has been raised with this copy of the code, the use, GTS2F400.13359 C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13360 C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13361 C Modelling at the above address. GTS2F400.13362 C ******************************COPYRIGHT****************************** GTS2F400.13363 C GTS2F400.13364 !+ Subroutine to initialize array of fluxes. INTFX3A.3 ! INTFX3A.4 ! Method: INTFX3A.5 ! A value is passed to the routine. This is used to initialize INTFX3A.6 ! arrays of total and direct, overall and clear fluxes as are INTFX3A.7 ! required for the calculation being performed. INTFX3A.8 ! INTFX3A.9 ! Current Owner of Code: J. M. Edwards INTFX3A.10 ! INTFX3A.11 ! History: INTFX3A.12 ! Version Date Comment INTFX3A.13 ! 4.0 27-07-95 Original Code INTFX3A.14 ! (J. M. Edwards) INTFX3A.15 ! INTFX3A.16 ! Description of Code: INTFX3A.17 ! FORTRAN 77 with extensions listed in documentation. INTFX3A.18 ! INTFX3A.19 !- --------------------------------------------------------------------- INTFX3A.20SUBROUTINE INITIALIZE_FLUX(N_PROFILE, N_LAYER, N_AUGMENT 6INTFX3A.21 & , ISOLIR INTFX3A.22 & , FLUX_DIRECT, FLUX_TOTAL INTFX3A.23 & , L_CLEAR INTFX3A.24 & , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR INTFX3A.25 & , VALUE INTFX3A.26 & , NPD_PROFILE, NPD_LAYER INTFX3A.27 & , L_NET INTFX3A.28 & ) INTFX3A.29 ! INTFX3A.30 ! INTFX3A.31 IMPLICIT NONE INTFX3A.32 ! INTFX3A.33 ! INTFX3A.34 ! SIZES OF DUMMY ARRAYS. INTFX3A.35 INTEGER !, INTENT(IN) INTFX3A.36 & NPD_PROFILE INTFX3A.37 ! MAXIMUM NUMBER OF PROFILES INTFX3A.38 & , NPD_LAYER INTFX3A.39 ! MAXIMUM NUMBER OF LAYERS INTFX3A.40 ! INTFX3A.41 ! INCLUDE COMDECKS. INTFX3A.42 *CALL SPCRG3A
INTFX3A.43 ! INTFX3A.44 ! DUMMY ARGUMENTS. INTFX3A.45 INTEGER !, INTENT(IN) INTFX3A.46 & N_PROFILE INTFX3A.47 ! NUMBER OF PROFILES INTFX3A.48 & , N_LAYER INTFX3A.49 ! NUMBER OF LAYERS INTFX3A.50 & , N_AUGMENT INTFX3A.51 ! LENGTH OF LONG FLUX VECTOR INTFX3A.52 & , ISOLIR INTFX3A.53 ! SPECTRAL REGION INTFX3A.54 LOGICAL !,INTENT(IN) INTFX3A.55 & L_CLEAR INTFX3A.56 ! CLEAR-SKY FIELD FLAG INTFX3A.57 REAL !, INTENT(IN) INTFX3A.58 & VALUE INTFX3A.59 ! VALUE FOR INITIALIZATION INTFX3A.60 REAL !, INTENT(OUT) INTFX3A.61 & FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER) INTFX3A.62 ! DIRECT FLUX INTFX3A.63 & , FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2) INTFX3A.64 ! TOTAL FLUX INTFX3A.65 & , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER) INTFX3A.66 ! CLEAR DIRECT FLUX INTFX3A.67 & , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2) INTFX3A.68 ! CLEAR TOTAL FLUX INTFX3A.69 ! VARIABLES SPECIFICALLY FOR THE UNIFIED MODEL. INTFX3A.70 LOGICAL !, INTENT(IN) INTFX3A.71 & L_NET INTFX3A.72 ! CALCULATE NET FLUXES INTFX3A.73 ! INTFX3A.74 ! LOCAL VARIABLES. INTFX3A.75 INTEGER INTFX3A.76 & I INTFX3A.77 ! LOOP VARIABLE INTFX3A.78 & , L INTFX3A.79 ! LOOP VARIABLE INTFX3A.80 ! INTFX3A.81 ! INTFX3A.82 IF (ISOLIR.EQ.IP_SOLAR) THEN INTFX3A.83 DO I=0, N_LAYER INTFX3A.84 DO L=1, N_PROFILE INTFX3A.85 FLUX_DIRECT(L, I)=VALUE INTFX3A.86 ENDDO INTFX3A.87 ENDDO INTFX3A.88 ENDIF INTFX3A.89 DO I=1, N_AUGMENT INTFX3A.90 DO L=1, N_PROFILE INTFX3A.91 FLUX_TOTAL(L, I)=VALUE INTFX3A.92 ENDDO INTFX3A.93 ENDDO INTFX3A.94 ! INTFX3A.95 IF (L_CLEAR) THEN INTFX3A.96 IF (ISOLIR.EQ.IP_SOLAR) THEN INTFX3A.97 DO I=0, N_LAYER INTFX3A.98 DO L=1, N_PROFILE INTFX3A.99 FLUX_DIRECT_CLEAR(L, I)=VALUE INTFX3A.100 ENDDO INTFX3A.101 ENDDO INTFX3A.102 ENDIF INTFX3A.103 DO I=1, N_AUGMENT INTFX3A.104 DO L=1, N_PROFILE INTFX3A.105 FLUX_TOTAL_CLEAR(L, I)=VALUE INTFX3A.106 ENDDO INTFX3A.107 ENDDO INTFX3A.108 ! INITIALIZE EXTRA AREAS IN THE CLEAR ARRAY FOR DIAGNOSTIC INTFX3A.109 ! CALCULATIONS: INTFX3A.110 IF (L_NET) THEN INTFX3A.111 DO L=1, N_PROFILE INTFX3A.112 FLUX_TOTAL_CLEAR(L, 2*N_LAYER+2)=VALUE INTFX3A.113 ENDDO INTFX3A.114 ENDIF INTFX3A.115 ENDIF INTFX3A.116 ! INTFX3A.117 ! INTFX3A.118 RETURN INTFX3A.119 END INTFX3A.120 *ENDIF DEF,A01_3A,OR,DEF,A02_3A INTFX3A.121 *ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.36