SUBROUTINE LLTORC(IGP,INTHLL,ISTHLL,IWSTLL,IESTLL, 14,2LLTORC1.6
& INTHRC,ISTHRC,IWSTRC,IESTRC) LLTORC1.7
IMPLICIT NONE LLTORC1.8
LLTORC1.9
! Description: LLTORC1.10
! Uses the gridpoint code, the lat/long spec of the required area, LLTORC1.11
! and the model area sizes to calculate the model row/column LLTORC1.12
! numbers for the area. LLTORC1.13
! Fix for the ocean model, since N is at the bottom. LLTORC1.14
! Called by PRELIM, INPUTL, ADDRES. LLTORC1.15
! LLTORC1.16
! Method: LLTORC1.17
! LLTORC1.18
! Current code owner: S.J.Swarbrick LLTORC1.19
! LLTORC1.20
! History: LLTORC1.21
! Version Date Comment LLTORC1.22
! ======= ==== ======= LLTORC1.23
! 3.5 Apr. 95 Original code. S.J.Swarbrick LLTORC1.24
! 4.1 Apr. 95 Add code for wave GSS3F401.680
! model grid S.J.Swarbrick GSS3F401.681
! 4.2 03/09/96 MPP code : Work on the global rather than GPB1F402.369
! local grid. P.Burton GPB1F402.370
! 4.3 13/03/97 MPP bugfix P.Burton GPB0F403.3075
! 4.5 18/08/98 Added DEF,FLDOP (A Van der Wal) GAV0F405.95
! LLTORC1.25
! Code description: LLTORC1.26
! FORTRAN 77 + common Fortran 90 extensions. LLTORC1.27
! Written to UM programming standards version 7. LLTORC1.28
! LLTORC1.29
! System component covered: LLTORC1.30
! System task: Sub-Models Project LLTORC1.31
! LLTORC1.32
! Global variables: LLTORC1.33
LLTORC1.34
*CALL CSUBMODL 
LLTORC1.35
*CALL VERSION LLTORC1.36
*CALL TYPSIZE GSS3F401.682
*CALL MODEL GSS3F401.683
*IF DEF,MPP,AND,-DEF,RECON GPB1F402.371
*CALL PARVARS GPB1F402.372
*CALL DECOMPTP GPB1F402.373
*CALL DECOMPDB GPB1F402.374
*ENDIF GPB1F402.375
LLTORC1.39
! Subroutine arguments: LLTORC1.40
LLTORC1.41
! Scalar arguments with intent(in): LLTORC1.42
INTEGER IGP ! Grid type code from STASHmaster GSS3F401.684
INTEGER INTHLL ! Lat/lon for N boundary LLTORC1.45
INTEGER ISTHLL ! Lat/lon for S boundary LLTORC1.46
INTEGER IWSTLL ! Lat/lon for W boundary LLTORC1.47
INTEGER IESTLL ! Lat/lon for E boundary LLTORC1.48
LLTORC1.49
! Scalar arguments with intent(out): LLTORC1.50
INTEGER INTHRC ! Row no for N bdry LLTORC1.52
INTEGER ISTHRC ! Row no for S bdry LLTORC1.53
INTEGER IWSTRC ! Col no for W bdry LLTORC1.54
INTEGER IESTRC ! Col no for E bdry LLTORC1.55
LLTORC1.56
! Local scalars LLTORC1.57
REAL DELX LLTORC1.60
REAL DELY LLTORC1.61
REAL RESTLL LLTORC1.62
REAL RWSTLL LLTORC1.63
REAL RESTRC LLTORC1.64
REAL RWSTRC LLTORC1.65
REAL RNTHRC LLTORC1.66
REAL RSTHRC LLTORC1.67
REAL RLAT1 LLTORC1.68
REAL RLON1 LLTORC1.69
REAL RLONL LLTORC1.70
INTEGER I LLTORC1.71
INTEGER LESTLL LLTORC1.72
INTEGER LNTHLL LLTORC1.73
INTEGER LSTHLL LLTORC1.74
INTEGER LWSTLL LLTORC1.75
INTEGER NCLS LLTORC1.76
INTEGER NRWS LLTORC1.77
LLTORC1.78
! Function and subroutine calls: LLTORC1.79
EXTERNAL LLTOLL,LLTOEQ LLTORC1.81
LLTORC1.82
!- End of Header --------------------------------------------------- LLTORC1.83
LLTORC1.84
LLTORC1.85
LNTHLL=INTHLL LLTORC1.86
LSTHLL=ISTHLL LLTORC1.87
LESTLL=IESTLL LLTORC1.88
LWSTLL=IWSTLL LLTORC1.89
IF(LWSTLL.LT.0) LWSTLL=LWSTLL+360 LLTORC1.90
IF(LESTLL.LT.0) LESTLL=LESTLL+360 LLTORC1.91
LLTORC1.92
IF((IGP.GE.1).AND.(IGP.LE.5)) THEN GSS3F401.685
!Basic atmos grid - theta points GSS3F401.686
RLAT1=H_A_FIRSTLAT LLTORC1.95
RLON1=H_A_FIRSTLONG LLTORC1.96
IF(IGP.EQ.5) THEN GSS3F401.687
! Meridional theta points GSS3F401.688
NRWS=1 LLTORC1.99
ELSE LLTORC1.100
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.376
NRWS=P_ROWS LLTORC1.101
*ELSE GPB1F402.377
NRWS=decomp_db_glsize(2,decomp_standard_atmos) GPB1F402.378
*ENDIF GPB1F402.379
END IF LLTORC1.102
IF(IGP.EQ.4) THEN GSS3F401.689
! Zonal theta points GSS3F401.690
NCLS=1 LLTORC1.105
ELSE LLTORC1.106
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.380
NCLS=ROW_LENGTH LLTORC1.107
*ELSE GPB1F402.381
NCLS=decomp_db_glsize(1,decomp_standard_atmos) GPB1F402.382
*ENDIF GPB1F402.383
END IF LLTORC1.108
DELX=H_A_EWSPACE LLTORC1.110
DELY=H_A_NSSPACE LLTORC1.111
LLTORC1.112
ELSE IF((IGP.GE.11).AND.(IGP.LE.15)) THEN LLTORC1.113
!Atmospheric uv points GSS3F401.691
RLAT1=H_A_FIRSTLAT-H_A_NSSPACE/2 LLTORC1.115
RLON1=H_A_FIRSTLONG+H_A_EWSPACE/2 LLTORC1.116
IF(IGP.EQ.15) THEN GSS3F401.692
! Zonal uv points GSS3F401.693
NRWS=1 LLTORC1.119
ELSE LLTORC1.120
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.384
NRWS=P_ROWS-1 LLTORC1.121
*ELSE GPB1F402.385
NRWS=decomp_db_glsize(2,decomp_standard_atmos)-1 GPB1F402.386
*ENDIF GPB1F402.387
END IF LLTORC1.122
IF(IGP.EQ.14) THEN GSS3F401.694
! Meridional uv points GSS3F401.695
NCLS=1 LLTORC1.125
ELSE LLTORC1.126
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.388
NCLS=ROW_LENGTH LLTORC1.127
*ELSE GPB1F402.389
NCLS=decomp_db_glsize(1,decomp_standard_atmos) GPB1F402.390
*ENDIF GPB1F402.391
END IF LLTORC1.128
DELX=H_A_EWSPACE LLTORC1.130
DELY=H_A_NSSPACE LLTORC1.131
LLTORC1.132
ELSE IF(IGP.EQ.17) THEN GSS3F401.696
!Atmospheric scalar field GSS3F401.697
RLAT1=H_A_FIRSTLAT LLTORC1.135
RLON1=H_A_FIRSTLONG LLTORC1.136
NRWS=1 LLTORC1.137
NCLS=1 LLTORC1.138
DELX=H_A_EWSPACE LLTORC1.139
DELY=H_A_NSSPACE LLTORC1.140
LLTORC1.141
ELSE IF(IGP.EQ.18) THEN LLTORC1.142
!c grid: atmospheric u points GSS3F401.698
RLAT1=H_A_FIRSTLAT LLTORC1.144
RLON1=H_A_FIRSTLONG+H_A_EWSPACE/2 LLTORC1.145
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.392
NRWS=P_ROWS LLTORC1.146
NCLS=ROW_LENGTH LLTORC1.147
*ELSE GPB1F402.393
NRWS=decomp_db_glsize(2,decomp_standard_atmos) GPB1F402.394
NCLS=decomp_db_glsize(1,decomp_standard_atmos) GPB1F402.395
*ENDIF GPB1F402.396
DELX=H_A_EWSPACE LLTORC1.148
DELY=H_A_NSSPACE LLTORC1.149
LLTORC1.150
ELSE IF(IGP.EQ.19) THEN LLTORC1.151
!c grid: atmospheric v points GSS3F401.699
RLAT1=H_A_FIRSTLAT-H_A_NSSPACE/2 LLTORC1.153
RLON1=H_A_FIRSTLONG LLTORC1.154
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.397
NRWS=P_ROWS-1 LLTORC1.155
NCLS=ROW_LENGTH LLTORC1.156
*ELSE GPB1F402.398
NRWS=decomp_db_glsize(2,decomp_standard_atmos)-1 GPB1F402.399
NCLS=decomp_db_glsize(1,decomp_standard_atmos) GPB1F402.400
*ENDIF GPB1F402.401
DELX=H_A_EWSPACE LLTORC1.157
DELY=H_A_NSSPACE LLTORC1.158
LLTORC1.159
ELSE IF(IGP.EQ.22) THEN GSS3F401.700
!Ozone grid GSS3F401.701
RLAT1=H_A_FIRSTLAT LLTORC1.162
RLON1=H_A_FIRSTLONG LLTORC1.163
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.402
NRWS=P_ROWS LLTORC1.164
*ELSE GPB1F402.403
NRWS=decomp_db_glsize(2,decomp_standard_atmos) GPB1F402.404
*ENDIF GPB1F402.405
IF (ZonAvOzone) THEN LLTORC1.166
NCLS=1 LLTORC1.167
ELSE LLTORC1.168
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.406
NCLS=ROW_LENGTH LLTORC1.169
*ELSE GPB1F402.407
NCLS=decomp_db_glsize(1,decomp_standard_atmos) GPB1F402.408
*ENDIF GPB1F402.409
END IF LLTORC1.170
DELX=H_A_EWSPACE LLTORC1.172
DELY=H_A_NSSPACE LLTORC1.173
LLTORC1.174
ELSE IF((IGP.EQ.31).OR.(IGP.EQ.36).OR.(IGP.EQ.41)) THEN LLTORC1.175
!Ocean mass points GSS3F401.702
RLAT1=H_O_FIRSTLAT LLTORC1.177
RLON1=H_O_FIRSTLONG LLTORC1.178
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.410
NRWS=NROWSO LLTORC1.179
*ELSE GPB1F402.411
NRWS=decomp_db_glsize(2,decomp_standard_ocean) GPB1F402.412
*ENDIF GPB1F402.413
NCLS=H_O_PTSPROW LLTORC1.180
DELX=H_O_EWSPACE LLTORC1.181
DELY=H_O_NSSPACE LLTORC1.182
LLTORC1.183
ELSE IF((IGP.EQ.32).OR.(IGP.EQ.37).OR.(IGP.EQ.42)) THEN LLTORC1.184
!Ocean velocity points GSS3F401.703
RLAT1=H_O_FIRSTLAT -H_O_NSSPACE/2 LLTORC1.186
RLON1=H_O_FIRSTLONG+H_O_EWSPACE/2 LLTORC1.187
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.414
NRWS=NROWSO-1 LLTORC1.188
*ELSE GPB1F402.415
NRWS=decomp_db_glsize(2,decomp_standard_ocean)-1 GPB1F402.416
*ENDIF GPB1F402.417
NCLS=H_O_PTSPROW LLTORC1.189
DELX=H_O_EWSPACE LLTORC1.190
DELY=H_O_NSSPACE LLTORC1.191
LLTORC1.192
ELSE IF(IGP.EQ.38) THEN LLTORC1.193
!c grid: ocean u points GSS3F401.704
RLAT1=H_O_FIRSTLAT LLTORC1.195
RLON1=H_O_FIRSTLONG+H_O_EWSPACE/2 LLTORC1.196
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.418
NRWS=NROWSO LLTORC1.197
*ELSE GPB1F402.419
NRWS=decomp_db_glsize(2,decomp_standard_ocean) GPB1F402.420
*ENDIF GPB1F402.421
NCLS=H_O_PTSPROW LLTORC1.198
DELX=H_O_EWSPACE LLTORC1.199
DELY=H_O_NSSPACE LLTORC1.200
LLTORC1.201
ELSE IF(IGP.EQ.39) THEN LLTORC1.202
!c grid: ocean v points GSS3F401.705
RLAT1=H_O_FIRSTLAT -H_O_NSSPACE/2 LLTORC1.204
RLON1=H_O_FIRSTLONG LLTORC1.205
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.422
NRWS=NROWSO-1 LLTORC1.206
*ELSE GPB1F402.423
NRWS=decomp_db_glsize(2,decomp_standard_ocean)-1 GPB1F402.424
*ENDIF GPB1F402.425
NCLS=H_O_PTSPROW LLTORC1.207
DELX=H_O_EWSPACE LLTORC1.208
DELY=H_O_NSSPACE LLTORC1.209
LLTORC1.210
ELSE IF(IGP.EQ.43) THEN LLTORC1.211
!Ocean zonal non-cyclic mass points GSS3F401.706
RLAT1=H_O_FIRSTLAT LLTORC1.213
RLON1=H_O_FIRSTLONG LLTORC1.214
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.426
NRWS=NROWSO LLTORC1.215
*ELSE GPB1F402.427
NRWS=decomp_db_glsize(2,decomp_standard_ocean) GPB1F402.428
*ENDIF GPB1F402.429
NCLS=1 LLTORC1.216
DELX=H_O_EWSPACE LLTORC1.217
DELY=H_O_NSSPACE LLTORC1.218
LLTORC1.219
ELSE IF(IGP.EQ.44) THEN LLTORC1.220
!Ocean zonal non-cyclic velocity points GSS3F401.707
RLAT1=H_O_FIRSTLAT -H_O_NSSPACE/2 LLTORC1.222
RLON1=H_O_FIRSTLONG+H_O_EWSPACE/2 LLTORC1.223
*IF -DEF,MPP,OR,DEF,RECON GPB1F402.430
NRWS=NROWSO-1 LLTORC1.224
*ELSE GPB1F402.431
NRWS=decomp_db_glsize(2,decomp_standard_ocean)-1 GPB1F402.432
*ENDIF GPB1F402.433
NCLS=1 LLTORC1.225
DELX=H_O_EWSPACE LLTORC1.226
DELY=H_O_NSSPACE LLTORC1.227
LLTORC1.228
ELSE IF(IGP.EQ.45) THEN LLTORC1.229
!Ocean meridional non-cyclic mass points GSS3F401.708
RLAT1=H_O_FIRSTLAT LLTORC1.231
RLON1=H_O_FIRSTLONG LLTORC1.232
NRWS=1 LLTORC1.233
NCLS=H_O_PTSPROW LLTORC1.234
DELX=H_O_EWSPACE LLTORC1.235
DELY=H_O_NSSPACE LLTORC1.236
LLTORC1.237
ELSE IF(IGP.EQ.46) THEN LLTORC1.238
!Ocean meridional non-cyclic velocity points GSS3F401.709
RLAT1=H_O_FIRSTLAT -H_O_NSSPACE/2 LLTORC1.240
RLON1=H_O_FIRSTLONG+H_O_EWSPACE/2 LLTORC1.241
NRWS=1 LLTORC1.242
NCLS=H_O_PTSPROW LLTORC1.243
DELX=H_O_EWSPACE LLTORC1.244
DELY=H_O_NSSPACE LLTORC1.245
LLTORC1.246
ELSE IF(IGP.EQ.47) THEN LLTORC1.247
!Ocean scalar points GSS3F401.710
RLAT1=H_O_FIRSTLAT LLTORC1.249
RLON1=H_O_FIRSTLONG LLTORC1.250
NRWS=1 LLTORC1.251
NCLS=1 LLTORC1.252
DELX=H_O_EWSPACE LLTORC1.253
DELY=H_O_NSSPACE LLTORC1.254
LLTORC1.255
ELSE IF(IGP.EQ.60.OR.IGP.EQ.62) THEN GSS3F401.711
!Wave model full grid GSS3F401.712
RLAT1=H_W_FIRSTLAT GSS3F401.713
RLON1=H_W_FIRSTLONG GSS3F401.714
NRWS =NROWSW GSS3F401.715
NCLS =NCOLSW GSS3F401.716
DELX =H_W_EWSPACE GSS3F401.717
DELY =H_W_NSSPACE GSS3F401.718
! ELSE IF(IGP.EQ.65) THEN GSS3F401.719
!Wave model LBC grid GSS3F401.720
GSS3F401.721
ELSE LLTORC1.256
INTHRC=0 LLTORC1.258
ISTHRC=-1 LLTORC1.259
IWSTRC=0 LLTORC1.260
IESTRC=-1 LLTORC1.261
GOTO 9999 LLTORC1.262
END IF LLTORC1.264
LLTORC1.265
IF((LNTHLL.EQ.90).AND.(LSTHLL.EQ.-90).AND. LLTORC1.266
&(LWSTLL.EQ.0).AND.(LESTLL.EQ.360)) THEN LLTORC1.267
IF (IGP.GE.60.AND.IGP.LT.70) THEN GSS3F401.722
INTHRC=NRWS GSS3F401.723
ISTHRC=1 GSS3F401.724
ELSE GSS3F401.725
INTHRC=1 LLTORC1.268
ISTHRC=NRWS LLTORC1.269
END IF GSS3F401.726
IWSTRC=1 LLTORC1.270
IESTRC=NCLS LLTORC1.271
GOTO 9999 LLTORC1.272
END IF LLTORC1.273
LLTORC1.274
! Convert to equatorial lat/long for LAM LLTORC1.275
IF(IGP.LE.30) THEN LLTORC1.277
! Atmos GSS3F401.727
IF(H_GLOBAL(A_IM).EQ.'N') THEN GSS3F401.728
CALL LLTOLL GSS3F401.729
& (LNTHLL,LSTHLL,LESTLL,LWSTLL,H_A_POLELAT,H_A_POLELONG) GSS3F401.730
END IF LLTORC1.285
ELSE IF(IGP.LT.60) THEN GSS3F401.731
! Ocean GSS3F401.732
IF(H_GLOBAL(O_IM).EQ.'N') THEN GSS3F401.733
CALL LLTOLL GSS3F401.734
& (LNTHLL,LSTHLL,LESTLL,LWSTLL,H_O_POLELAT,H_O_POLELONG) GSS3F401.735
END IF LLTORC1.295
END IF LLTORC1.297
LLTORC1.298
IF(RLON1.LT.0) RLON1=RLON1+360. LLTORC1.299
LLTORC1.300
IF (IGP.GE.60.AND.IGP.LT.70) THEN GSS3F401.736
!Wave model grid - RLAT1 is southern most latitude GSS3F401.737
RNTHRC=1.999+(LNTHLL-RLAT1)/DELY GSS3F401.738
RSTHRC=1. +(LSTHLL-RLAT1)/DELY GSS3F401.739
ELSE GSS3F401.740
IF(DELY.GT.0) THEN GSS3F401.741
!Atmos model grid - RLAT1 is northern most latitude GSS3F401.742
RNTHRC=1. +(RLAT1-LNTHLL)/DELY GSS3F401.743
RSTHRC=1.999+(RLAT1-LSTHLL)/DELY GSS3F401.744
ELSE GSS3F401.745
RNTHRC=1. +(RLAT1-LSTHLL)/DELY GSS3F401.746
RSTHRC=1.999+(RLAT1-LNTHLL)/DELY GSS3F401.747
END IF GSS3F401.748
END IF GSS3F401.749
LLTORC1.308
INTHRC=RNTHRC LLTORC1.309
INTHRC=MAX(1,INTHRC) LLTORC1.310
ISTHRC=RSTHRC LLTORC1.311
ISTHRC=MIN(NRWS,ISTHRC) LLTORC1.312
LLTORC1.313
RLONL=RLON1+DELX*(NCLS-1) LLTORC1.314
LLTORC1.315
IF(RLONL.LE.360.) THEN GSS3F401.750
! Global model does not cut area GSS3F401.751
RWSTRC=1.+(LWSTLL-RLON1)/DELX LLTORC1.318
IWSTRC=RWSTRC LLTORC1.319
RESTRC=1.999+(LESTLL-RLON1)/DELX LLTORC1.320
IESTRC=RESTRC LLTORC1.321
ELSE GSS3F401.752
! Global model does cut area GSS3F401.753
RWSTLL=LWSTLL LLTORC1.325
IF(RWSTLL.LT.RLON1) THEN GSS3F401.754
! W edge after global model GSS3F401.755
RWSTRC=1.+(RWSTLL+360.-RLON1)/DELX LLTORC1.328
IWSTRC=RWSTRC LLTORC1.329
IF (IWSTRC.GT.NCLS) IWSTRC=1 LLTORC1.330
ELSE GSS3F401.756
! W edge before global model GSS3F401.757
RWSTRC=1.+(RWSTLL-RLON1)/DELX LLTORC1.332
IWSTRC=RWSTRC LLTORC1.333
END IF LLTORC1.334
RESTLL=LESTLL LLTORC1.336
IF(RESTLL.LT.RLON1) THEN GSS3F401.758
! E edge after global model GSS3F401.759
RESTRC=1.+(RESTLL+360.-RLON1)/DELX LLTORC1.339
IESTRC=RESTRC LLTORC1.340
ELSE GSS3F401.760
! E edge before global model GSS3F401.761
RESTRC=1.+(RESTLL-RLON1)/DELX LLTORC1.342
IESTRC=RESTRC LLTORC1.343
END IF LLTORC1.344
END IF GSS3F401.762
LLTORC1.347
IWSTRC=MAX(1,IWSTRC) LLTORC1.348
IESTRC=MAX(1,IESTRC) LLTORC1.349
IWSTRC=MIN(NCLS,IWSTRC) LLTORC1.350
IESTRC=MIN(NCLS,IESTRC) LLTORC1.351
LLTORC1.352
9999 RETURN LLTORC1.353
END LLTORC1.354
LLTORC1.355
!- End of subroutine code ---------------------------------------- LLTORC1.356
LLTORC1.357
LLTORC1.358
!+Use subroutine LLTOEQ to convert to equatorial lat/lon for LAM LLTORC1.359
! Subroutine Interface: LLTORC1.360
LLTORC1.361
SUBROUTINE LLTOLL(LNTHLL,LSTHLL,LESTLL,LWSTLL, 2,1LLTORC1.362
& PHI_POLE,LAMBDA_POLE) LLTORC1.363
LLTORC1.364
! Description: LLTORC1.365
! LLTORC1.366
! Method: LLTORC1.367
! LLTORC1.368
! Current code owner: S.J.Swarbrick LLTORC1.369
! LLTORC1.370
! History: LLTORC1.371
! Version Date Comment LLTORC1.372
! ======= ==== ======= LLTORC1.373
! 3.5 Apr. 95 Original code. S.J.Swarbrick LLTORC1.374
! LLTORC1.375
! Code description: LLTORC1.376
! FORTRAN 77 + common Fortran 90 extensions. LLTORC1.377
! Written to UM programming standards version 7. LLTORC1.378
! LLTORC1.379
! System component covered: LLTORC1.380
! System task: Sub-Models Project LLTORC1.381
LLTORC1.382
! Subroutine arguments: LLTORC1.383
LLTORC1.384
! Scalar arguments with intent(in): LLTORC1.385
REAL PHI_POLE ! Latitude of pole in equatorial system LLTORC1.387
REAL LAMBDA_POLE ! Longitude do. LLTORC1.388
LLTORC1.389
! Scalar arguments with intent(inout): LLTORC1.390
INTEGER LNTHLL LLTORC1.392
INTEGER LSTHLL LLTORC1.393
INTEGER LESTLL LLTORC1.394
INTEGER LWSTLL LLTORC1.395
LLTORC1.396
! Local parameters: LLTORC1.397
INTEGER POINTS LLTORC1.399
PARAMETER(POINTS=9) LLTORC1.400
LLTORC1.401
! Local arrays: LLTORC1.402
REAL PHI (POINTS) LLTORC1.404
REAL LAMBDA (POINTS) LLTORC1.405
REAL LAMBDA_EQ(POINTS) LLTORC1.406
REAL PHI_EQ (POINTS) LLTORC1.407
LLTORC1.408
!- End of Header ----------------------------------------------------- LLTORC1.409
LLTORC1.410
LLTORC1.411
PHI(1)=LNTHLL LLTORC1.412
PHI(2)=LNTHLL LLTORC1.413
PHI(3)=LNTHLL LLTORC1.414
PHI(4)=(LNTHLL+LSTHLL)/2 LLTORC1.415
PHI(5)=(LNTHLL+LSTHLL)/2 LLTORC1.416
PHI(6)=LSTHLL LLTORC1.417
PHI(7)=LSTHLL LLTORC1.418
PHI(8)=LSTHLL LLTORC1.419
PHI(9)=(LNTHLL+LSTHLL)/2 LLTORC1.420
LAMBDA(1)=LWSTLL LLTORC1.421
IF(LWSTLL.LT.LESTLL) THEN LLTORC1.422
LAMBDA(2)=(LWSTLL+LESTLL)/2 LLTORC1.423
ELSE LLTORC1.424
LAMBDA(2)=(LWSTLL+LESTLL-360)/2 LLTORC1.425
IF(LAMBDA(2).LT.0) LAMBDA(2)=LAMBDA(2)+360 LLTORC1.426
END IF LLTORC1.427
LAMBDA(3)=LESTLL LLTORC1.428
LAMBDA(4)=LWSTLL LLTORC1.429
LAMBDA(5)=LESTLL LLTORC1.430
LAMBDA(6)=LWSTLL LLTORC1.431
LAMBDA(7)=LAMBDA(2) LLTORC1.432
LAMBDA(8)=LESTLL LLTORC1.433
LAMBDA(9)=LAMBDA(2) LLTORC1.434
LLTORC1.435
CALL LLTOEQ LLTORC1.436
* (PHI,LAMBDA,PHI_EQ,LAMBDA_EQ,PHI_POLE,LAMBDA_POLE,POINTS) LLTORC1.437
LLTORC1.438
IF(LAMBDA_EQ(3).LT.LAMBDA_EQ(2)) LAMBDA_EQ(2)=LAMBDA_EQ(2)-360. LLTORC1.439
IF(LAMBDA_EQ(2).LT.LAMBDA_EQ(1)) LAMBDA_EQ(1)=LAMBDA_EQ(1)-360. LLTORC1.440
IF(LAMBDA_EQ(5).LT.LAMBDA_EQ(9)) LAMBDA_EQ(9)=LAMBDA_EQ(9)-360. LLTORC1.441
IF(LAMBDA_EQ(9).LT.LAMBDA_EQ(4)) LAMBDA_EQ(4)=LAMBDA_EQ(4)-360. LLTORC1.442
IF(LAMBDA_EQ(8).LT.LAMBDA_EQ(7)) LAMBDA_EQ(7)=LAMBDA_EQ(7)-360. LLTORC1.443
IF(LAMBDA_EQ(7).LT.LAMBDA_EQ(6)) LAMBDA_EQ(6)=LAMBDA_EQ(6)-360. LLTORC1.444
LLTORC1.445
RNTHLL=PHI_EQ(1) LLTORC1.446
RSTHLL=PHI_EQ(1) LLTORC1.447
RESTLL=LAMBDA_EQ(1) LLTORC1.448
RWSTLL=LAMBDA_EQ(1) LLTORC1.449
LLTORC1.450
DO I=2,8 LLTORC1.451
RNTHLL=MAX(RNTHLL,PHI_EQ(I)) LLTORC1.452
RSTHLL=MIN(RSTHLL,PHI_EQ(I)) LLTORC1.453
RWSTLL=MIN(RWSTLL,LAMBDA_EQ(I)) LLTORC1.454
RESTLL=MAX(RESTLL,LAMBDA_EQ(I)) LLTORC1.455
END DO LLTORC1.456
LLTORC1.457
IF(RWSTLL.LT.0) RWSTLL=RWSTLL+360. LLTORC1.458
IF(RESTLL.LT.0) RESTLL=RESTLL+360. LLTORC1.459
RNTHLL=RNTHLL+.999 LLTORC1.460
LNTHLL=RNTHLL LLTORC1.461
LNTHLL=MIN(90,LNTHLL) LLTORC1.462
LSTHLL=RSTHLL LLTORC1.463
LWSTLL=RWSTLL LLTORC1.464
RESTLL=RESTLL+.999 LLTORC1.465
LESTLL=RESTLL LLTORC1.466
LESTLL=MIN(360,LESTLL) LLTORC1.467
LLTORC1.468
RETURN LLTORC1.469
END LLTORC1.470
LLTORC1.471
!- End of subroutine code --------------------------------------------- LLTORC1.472
*ENDIF LLTORC1.473