SUBROUTINE ADDRLN(IGPL,LEN, 4,8GPB1F402.270
*IF DEF,MPP GPB1F402.271
& size_type, GPB1F402.272
*ENDIF GPB1F402.273
& ErrorStatus) GPB1F402.274
IMPLICIT NONE ADDRLN1.7
! Description: ADDRLN1.8
! ADDRLN1.9
! Method: ADDRLN1.10
! ADDRLN1.11
! Current code owner: S.J.Swarbrick ADDRLN1.12
! ADDRLN1.13
! History: ADDRLN1.14
! Version Date Comment ADDRLN1.15
! ======= ==== ======= ADDRLN1.16
! 3.5 Apr. 95 Original code. S.J.Swarbrick ADDRLN1.17
! 4.0 05/12/95 Cater for ozone zonal/full fields. D. Robinson GDR4F400.13
! 4.1 June 96 Enhanced for wave model etc. S.J.Swarbrick GSS3F401.49
! 4.1 20/03/96 Modify lengths of some types of fields for GPB0F401.104
! MPP code. P.Burton GPB0F401.105
! 4.1 20/03/95 Allow a rimwidth for ocean LAM. S.Ineson GOK0F401.1
! 4.2 03/09/96 Tidy up MPP addressing and GPB1F402.275
! add extra argument for MPP version GPB1F402.276
! which allows local or global data size to GPB1F402.277
! be calculated. P.Burton GPB1F402.278
! 4.3 13/03/97 Further MPP changes P.Burton GPB0F403.3022
! 4.4 05/09/97 Modify LENRIMDATA_A for nonMPP case to use L_LSPICE ARB1F404.8
! as this is also used in reconfiguration which does ARB1F404.9
! not call DERVSIZE. RTHBarnes. ARB1F404.10
! 4.5 12/09/97 New ocean LAM code. C.G.Jones/S.Ineson/M.Bell GSI1F405.1
! 4.5 18/08/98 Added DEF,FLDOP (A Van der Wal) GAV0F405.89
! 4.5 15/04/98 Use new variables global/local_land_field GDR5F405.26
! for fields on land points. D. Robinson. GDR5F405.27
! ADDRLN1.18
! Code description: ADDRLN1.19
! FORTRAN 77 + common Fortran 90 extensions. ADDRLN1.20
! Written to UM programming standards version 7. ADDRLN1.21
! ADDRLN1.22
! System component covered: ADDRLN1.23
! System task: Sub-Models Project ADDRLN1.24
! ADDRLN1.25
! Global variables: ADDRLN1.26
*CALL CSUBMODL 
ADDRLN1.28
*CALL VERSION ADDRLN1.29
*CALL TYPSIZE GSS3F401.50
*CALL CNTLATM ARB1F404.11
*CALL CNTLOCN GSI1F405.2
*CALL MODEL GSS3F401.51
*IF DEF,MPP GPB1F402.279
*CALL PARVARS GPB1F402.280
*ENDIF GPB1F402.281
ADDRLN1.32
! Subroutine arguments: ADDRLN1.33
! Scalar arguments with intent(in): ADDRLN1.34
INTEGER IGPL ADDRLN1.35
ADDRLN1.36
! Scalar arguments with intent(out): ADDRLN1.37
INTEGER LEN ADDRLN1.38
*IF DEF,MPP GPB1F402.282
INTEGER size_type ! IN : indicates whether local or global GPB1F402.283
! ! data size is required GPB1F402.284
*ENDIF GPB1F402.285
GPB1F402.286
CHARACTER*80 CMESSAGE GSS3F401.52
ADDRLN1.39
! Local scalars: ADDRLN1.40
INTEGER I ADDRLN1.41
INTEGER IP ADDRLN1.42
INTEGER IQ ADDRLN1.43
INTEGER IT ADDRLN1.44
INTEGER IX1 ADDRLN1.45
INTEGER IX2 ADDRLN1.46
INTEGER IY1 ADDRLN1.47
INTEGER IY2 ADDRLN1.48
*IF DEF,MPP GPB1F402.287
INTEGER GPB0F403.3023
& local_IX1,local_IX2,local_IY1,local_IY2 GPB0F403.3024
&, fld_type ! indicates if field on u or p grid GPB0F403.3025
GPB0F403.3026
INTEGER GPB0F403.3027
& GET_FLD_TYPE ! function for finding the field typr GPB0F403.3028
*ENDIF GPB1F402.289
INTEGER GPB0F403.3029
& ocean_extra_pts ! extra points added to ocean row length GPB0F403.3030
! ! to allow for the wrap around pts at the GPB0F403.3031
! ! start and end of each global row GPB0F403.3032
*IF -DEF,MPP GSI1F405.3
C Local variables for calculation of ocean LAM dimensions GSI1F405.4
integer n_obdy_t_grd ! # of ocean bdy fields } on T grid GSI1F405.5
integer n_obdy_u_grd ! stored in dump } on u/v grid GSI1F405.6
integer numside_rowso ! # of rows in each ocean bdy field GSI1F405.7
integer numside_colso ! # of columns in each ocean bdy field GSI1F405.8
integer count ! loop counter GSI1F405.9
integer num_o_tracers ! # of ocean tracer fields - used because GSI1F405.10
! nt is not initialised in reconfig code GSI1F405.11
*ENDIF GSI1F405.12
ADDRLN1.49
! ErrorStatus: ADDRLN1.50
INTEGER ErrorStatus ADDRLN1.51
ADDRLN1.52
! Function and subroutine calls: ADDRLN1.53
EXTERNAL LLTORC,LEVCOD ADDRLN1.54
ADDRLN1.55
!- End of Header --------------------------------------------------- ADDRLN1.56
ADDRLN1.57
! Determine row/column nos. for global domain ADDRLN1.58
CALL LLTORC(IGPL,90,-90,0,360,IY1,IY2,IX1,IX2) ADDRLN1.59
GPB1F402.290
*IF DEF,MPP GPB1F402.291
IF ((size_type .EQ. local_data) .AND. GPB0F403.3033
& ((IGPL .NE. 21) .AND. (IGPL .NE. 25) .AND. GPB0F403.3034
& (IGPL .NE. 31) .AND. (IGPL .NE. 32) .AND. GPB0F403.3035
& (IGPL .NE. 51))) THEN GPB0F403.3036
GPB0F403.3037
! Convert the global subdomain limits to local subdomain limits GPB1F402.293
CALL GLOBAL_TO_LOCAL_SUBDOMAIN( .TRUE.,.TRUE., GPB1F402.294
& IGPL,mype, GPB1F402.295
& IY1,IX2,IY2,IX1, GPB1F402.296
& local_IY1,local_IX2, GPB1F402.297
& local_IY2,local_IX1) GPB1F402.298
GPB1F402.299
GPB0F403.3038
IX1=local_IX1 GPB1F402.300
IX2=local_IX2 GPB1F402.301
IY1=local_IY1 GPB1F402.302
IY2=local_IY2 GPB1F402.303
GPB0F403.3039
ocean_extra_pts=0 GPB0F403.3040
IF (atleft) ocean_extra_pts=ocean_extra_pts+1 GPB0F403.3041
IF (atright) ocean_extra_pts=ocean_extra_pts+1 GPB0F403.3042
ELSE GPB0F403.3043
ocean_extra_pts=2 ! extra pt at start and end of row for GPB0F403.3044
! ! wrap around GPB0F403.3045
ENDIF GPB1F402.304
*ELSE GPB0F403.3046
ocean_extra_pts=2 ! extra pt at start and end of row for GPB0F403.3047
! ! wrap around GPB0F403.3048
*ENDIF GPB1F402.305
ADDRLN1.60
IF(IGPL.EQ.21) THEN ADDRLN1.61
*IF DEF,ATMOS,AND,DEF,MPP GPB1F402.306
IF (size_type .EQ. local_data) THEN GPB1F402.307
len = local_land_field GDR5F405.28
ELSE GPB1F402.309
LEN=LAND_FIELD GPB1F402.310
len = global_land_field GDR5F405.29
ENDIF GPB1F402.311
*ELSE GPB0F401.112
LEN=LAND_FIELD ADDRLN1.62
*ENDIF GPB0F401.113
ELSE IF(IGPL.EQ.22) THEN ADDRLN1.63
IF (ZonAvOzone) THEN ! Zonal GDR4F400.14
*IF -DEF,MPP GPB0F403.3049
LEN = IY2-IY1+1 GDR4F400.15
*ELSE GPB0F403.3050
IF (size_type .EQ. local_data) THEN GPB0F403.3051
LEN = IY2-IY1+1+2*Offy ! include halos GPB0F403.3052
ELSE GPB0F403.3053
LEN = IY2-IY1+1 GPB0F403.3054
ENDIF GPB0F403.3055
*ENDIF GPB0F403.3056
ELSE ! Full fields GDR4F400.16
LEN = (IX2-IX1+1)*(IY2-IY1+1) GDR4F400.17
ENDIF GDR4F400.18
ELSE IF(IGPL.EQ.25) THEN ADDRLN1.65
*IF DEF,MPP GPB1F402.312
IF (size_type .EQ. local_data) THEN GPB1F402.313
LEN=LENRIMDATA_A ! this value calculated in DERVSIZE GPB1F402.314
ELSE GPB1F402.315
LEN=global_LENRIMDATA_A GPB1F402.316
ENDIF GPB1F402.317
*ELSE GPB0F401.116
! Could use LEN = LENRIMDATA_A from DERVSIZE in nonMPP model, but ARB1F404.12
! this value is also needed in reconfiguration which does not call ARB1F404.13
! DERVSIZE, so recalculated here using L_LSPICE_BDY from CNTLATM. ARB1F404.14
CALL LEVCOD( 2,IP,ErrorStatus,CMESSAGE) ! pressure levels ARB1F404.15
CALL LEVCOD( 3,IQ,ErrorStatus,CMESSAGE) ! wet levels ARB1F404.16
CALL LEVCOD(11,IT,ErrorStatus,CMESSAGE) ! tracer levels ARB1F404.17
IF (L_LSPICE_BDY) THEN ARB1F404.18
IQ = 2*IQ ! for mixed phase precip LBCs contain QT & QCF ARB1F404.19
END IF ARB1F404.20
LEN=(P_ROWS+ROW_LENGTH-2*RIMWIDTHA)*2*RIMWIDTHA* ADDRLN1.69
* (1+3*IP+IQ+TR_VARS*IT)-2*IP*4*RIMWIDTHA ADDRLN1.70
*ENDIF GPB0F401.117
ELSE IF((IGPL.EQ.31).OR.(IGPL.EQ.32)) THEN ADDRLN1.71
LEN = -1 ! SET FLAG AT THIS STAGE AS A MULTI-LEVEL COMPRESS ADDRLN1.72
ELSE IF (COX_O .AND. ((IGPL .GE. 36) .AND. (IGPL .LE.39))) THEN GPB0F403.3057
*IF -DEF,MPP GPB0F403.3058
LEN=(IX2-IX1+1+ocean_extra_pts)*(IY2-IY1+1) GPB0F403.3059
*ELSE GPB0F403.3060
IF (size_type .EQ. local_data) THEN GPB0F403.3061
! Primary fields on the wind grid are overdimensioned by one GPB0F403.3062
! row to make them the same size as the mass grid GPB0F403.3063
fld_type=GET_FLD_TYPE(IGPL) GPB0F403.3064
GPB0F403.3065
IF (atbase .AND. (fld_type .EQ. fld_type_u)) THEN GPB0F403.3066
LEN=(IX2-IX1+1+ocean_extra_pts)*(IY2-IY1+2+2*Offy) GPB0F403.3067
ELSE GPB0F403.3068
LEN=(IX2-IX1+1+ocean_extra_pts)*(IY2-IY1+1+2*Offy) GPB0F403.3069
ENDIF GPB0F403.3070
ELSE GPB0F403.3071
LEN=(IX2-IX1+1+ocean_extra_pts)*(IY2-IY1+1) GPB0F403.3072
ENDIF GPB0F403.3073
*ENDIF GPB0F403.3074
*IF DEF,MPP ORH5F403.295
ELSE IF (IGPL.EQ.41) THEN ORH5F403.296
! This is without cyclic points so we dont include ORH5F403.297
! ocean_extra_pts in the calculation. ORH5F403.298
LEN =(IX2-IX1+1+2*Offx)*(IY2-IY1+1+2*Offy) ORH5F403.299
ELSE IF (IGPL.EQ.42) THEN ORH5F403.300
! This is without cyclic points so we dont include ORH0F404.8
! ocean_extra_pts in the calculation. ORH0F404.9
fld_type=GET_FLD_TYPE(IGPL) ORH0F404.10
IF (atbase .AND. (fld_type .EQ. fld_type_u)) THEN ORH0F404.11
LEN =(IX2-IX1+1+2*Offx)*(IY2-IY1+2+2*Offy) ORH0F404.12
ELSE ORH0F404.13
LEN =(IX2-IX1+1+2*Offx)*(IY2-IY1+1+2*Offy) ORH0F404.14
ENDIF ORH0F404.15
*ENDIF ORH5F403.304
ELSE IF(IGPL.EQ.51) THEN ADDRLN1.81
*IF DEF,MPP GSI1F405.13
IF (size_type .EQ. local_data) THEN GSI1F405.14
LEN = LENRIMDATA_O GSI1F405.15
ELSE GSI1F405.16
LEN = global_LENRIMDATA_O GSI1F405.17
ENDIF GSI1F405.18
*ELSE GSI1F405.19
GSI1F405.20
CL Calculate the number of ocean tracers then the length GSI1F405.21
CL of boundary data. NT is not available from reconfig code. GSI1F405.22
GSI1F405.23
num_o_tracers =2 GSI1F405.24
do count = 1, 18 ! extra tracers GSI1F405.25
if (TRACER_O(count)) num_o_tracers = num_o_tracers + 1 GSI1F405.26
end do GSI1F405.27
GSI1F405.28
call o_lbc_sizes( NLEVSO, num_o_tracers, rimwidtho, GSI1F405.29
# numside_rowso, numside_colso, GSI1F405.30
# RIM_LOOKUPSO, n_obdy_t_grd, n_obdy_u_grd ) GSI1F405.31
GSI1F405.32
C LEN is the length on the local processor so usually velocity data GSI1F405.33
C will have same number of rows as tracer data GSI1F405.34
GSI1F405.35
LEN = (ncolso*numside_rowso+nrowso*numside_colso)*n_obdy_t_grd GSI1F405.36
& + ((ncolso-1)*numside_rowso+(nrowso)*numside_colso) GSI1F405.37
& *n_obdy_u_grd GSI1F405.38
GSI1F405.39
*ENDIF GSI1F405.40
ELSE IF(IGPL.EQ.62) THEN GSS3F401.56
!Wave model - sea points only GSS3F401.57
LEN=W_SEA_POINTS GSS3F401.58
ELSE ADDRLN1.89
IF (IGPL.GE.60.AND.IGPL.LT.70) THEN GSS3F401.59
!Wave model grid - first lat is southern most GSS3F401.60
LEN =(IX2-IX1+1)*(IY1-IY2+1) GSS3F401.61
ELSE GSS3F401.62
!Atmos grid - first lat is northern most GSS3F401.63
LEN =(IX2-IX1+1)*(IY2-IY1+1) GSS3F401.64
END IF GSS3F401.65
END IF ADDRLN1.91
ADDRLN1.92
RETURN ADDRLN1.93
END ADDRLN1.94
ADDRLN1.95
!- End of subroutine code ------------------------------------------ ADDRLN1.96
*ENDIF ADDRLN1.97