SUBROUTINE UM_Submodel_Init(ErrorStatus) 3UMSUBIN1.6
UMSUBIN1.7
IMPLICIT NONE UMSUBIN1.8
! UMSUBIN1.9
! Description: UMSUBIN1.10
! UM_Submodel_Init initialises the model with information specifying UMSUBIN1.11
! internal model and submodel partitions for the run, which is UMSUBIN1.12
! required for control of coupling when more than one internal model UMSUBIN1.13
! is present. UMSUBIN1.14
! UMSUBIN1.15
! Method: UMSUBIN1.16
! The routine reads information from the user interface, providing UMSUBIN1.17
! lists of internal models and their associated submodel data UMSUBIN1.18
! partitions. This is required in both the reconfiguration and the UMSUBIN1.19
! model as a prior step to calculating addressing in STASH_PROC. UMSUBIN1.20
! UMSUBIN1.21
! Current Code Owner: R. Rawlins UMSUBIN1.22
! History: UMSUBIN1.23
! Version Date Comment UMSUBIN1.24
! ------- ---- ------- UMSUBIN1.25
! 3.5 07/04/95 Original code. R. Rawlins. UMSUBIN1.26
!LL 4.3-4.4 16/09/97 D1 addressing change and subsequent correction GSM2F404.179
!LL S.D.Mullerworth GSM2F404.180
! UMSUBIN1.27
! Code Description: UMSUBIN1.28
! Language: FORTRAN 77 + common extensions. UMSUBIN1.29
! This code is written to UMDP3 v6 programming standards. UMSUBIN1.30
! UMSUBIN1.31
! System component covered: UMSUBIN1.32
! System Task: UMSUBIN1.33
! Declarations: UMSUBIN1.34
! UMSUBIN1.35
! UMSUBIN1.36
! Global variables (*CALLed COMDECKs etc...): UMSUBIN1.37
*CALL CSUBMODL 
UMSUBIN1.38
C An alternative common block required by TYPD1 GSM2F403.208
*CALL CALTSUBM GSM2F403.209
! Subroutine arguments UMSUBIN1.40
! Scalar arguments with intent(in): UMSUBIN1.41
UMSUBIN1.42
! Array arguments with intent(in): UMSUBIN1.43
UMSUBIN1.44
! Scalar arguments with intent(InOut): UMSUBIN1.45
UMSUBIN1.46
! Array arguments with intent(InOut): UMSUBIN1.47
UMSUBIN1.48
! Scalar arguments with intent(out): UMSUBIN1.49
UMSUBIN1.50
! Array arguments with intent(out): UMSUBIN1.51
UMSUBIN1.52
! ErrorStatus UMSUBIN1.53
INTEGER ErrorStatus ! Error flag (0 = OK) UMSUBIN1.54
UMSUBIN1.55
! Local parameters: UMSUBIN1.56
UMSUBIN1.57
! Local scalars: UMSUBIN1.58
INTEGER UMSUBIN1.59
* s ! submodel loop UMSUBIN1.60
*,i ! internal model loop UMSUBIN1.61
*,sm ! submodel identifier UMSUBIN1.62
*,im ! internal model identifier UMSUBIN1.63
*,sm_prev ! previous submodel identifier UMSUBIN1.64
*,im_prev ! previous internal model identifier UMSUBIN1.65
UMSUBIN1.66
! Local dynamic arrays: UMSUBIN1.67
UMSUBIN1.68
! Function & Subroutine calls: None UMSUBIN1.69
UMSUBIN1.70
!- End of header UMSUBIN1.71
! UMSUBIN1.72
! 1. Initialise lists before obtaining values for this experiment. UMSUBIN1.73
! UMSUBIN1.74
do i=1,N_INTERNAL_MODEL_MAX UMSUBIN1.75
INTERNAL_MODEL_LIST(i) = 0 UMSUBIN1.76
SUBMODEL_FOR_IM(i) = 0 UMSUBIN1.77
enddo ! i over internal model list UMSUBIN1.78
UMSUBIN1.79
do im=1,INTERNAL_ID_MAX UMSUBIN1.80
SUBMODEL_PARTITION_INDEX(im) = 0 UMSUBIN1.81
INTERNAL_MODEL_INDEX(im) = 0 UMSUBIN1.82
LAST_IM_IN_SM(im)=.false. UMSUBIN1.83
enddo ! im over internal model ids UMSUBIN1.84
UMSUBIN1.85
do s=1,N_SUBMODEL_PARTITION_MAX UMSUBIN1.86
SUBMODEL_PARTITION_LIST(s)= 0 UMSUBIN1.87
SUBMODEL_FOR_SM(s)=0 GSM2F403.210
enddo ! s over submodel list UMSUBIN1.88
UMSUBIN1.89
do sm=1,SUBMODEL_ID_MAX UMSUBIN1.90
N_INTERNAL_FOR_SM(sm) = 0 UMSUBIN1.91
enddo ! sm over submodel ids UMSUBIN1.92
UMSUBIN1.93
! UMSUBIN1.94
! 2. Obtain internal model and submodel identifiers from umui UMSUBIN1.95
! generated namelist. UMSUBIN1.96
! UMSUBIN1.97
read(5,NSUBMODL) UMSUBIN1.98
! UMSUBIN1.99
! UMSUBIN1.100
! 3. Check umui supplied values. UMSUBIN1.101
! UMSUBIN1.102
! UMSUBIN1.103
! 3.1 Check for umui supplied dimensions against parameter maxima. UMSUBIN1.104
UMSUBIN1.105
if(N_INTERNAL_MODEL.gt.N_INTERNAL_MODEL_MAX) then UMSUBIN1.106
write(6,*) 'UM_Submodel_In: FATAL ERROR. Too many internal ', UMSUBIN1.107
* 'models =',N_INTERNAL_MODEL, UMSUBIN1.108
* ' :You need to increase N_INTERNAL_MODEL_MAX' UMSUBIN1.109
ErrorStatus=1 ! Set error flag UMSUBIN1.110
endif UMSUBIN1.111
! UMSUBIN1.112
! 3.2 Check umui suppiled values are valid UMSUBIN1.113
! UMSUBIN1.114
do i=1,N_INTERNAL_MODEL ! loop over internal models UMSUBIN1.115
UMSUBIN1.116
im = INTERNAL_MODEL_LIST(i) ! internal model identifier UMSUBIN1.117
if(im.le.0.or.im.gt.INTERNAL_ID_MAX) then UMSUBIN1.118
write(6,*) 'UM_Submodel_In: FATAL ERROR. Illegal internal ', UMSUBIN1.119
* 'model identifier=',im, UMSUBIN1.120
* ' :Check values in namelist NSUBMODL supplied by umui' UMSUBIN1.121
ErrorStatus=1 ! Set error flag UMSUBIN1.122
endif UMSUBIN1.123
UMSUBIN1.124
sm = SUBMODEL_FOR_IM(i) ! submodel for this internal model UMSUBIN1.125
if(sm.le.0.or.sm.gt.SUBMODEL_ID_MAX) then UMSUBIN1.126
write(6,*) 'UM_Submodel_In: FATAL ERROR. Illegal submodel ', UMSUBIN1.127
* 'dump identifier=',sm, UMSUBIN1.128
* ' :Check values in namelist NSUBMODL supplied by umui' UMSUBIN1.129
ErrorStatus=1 ! Set error flag UMSUBIN1.130
endif UMSUBIN1.131
UMSUBIN1.132
enddo ! i=1,N_INTERNAL_MODEL UMSUBIN1.133
! UMSUBIN1.134
! 4. Form internal model and submodel description arrays. UMSUBIN1.135
! UMSUBIN1.136
sm_prev = 0 ! Null value of submodel identifier UMSUBIN1.137
N_SUBMODEL_PARTITION=0 ! Count no. of submodel partitions UMSUBIN1.138
UMSUBIN1.139
do i=1,N_INTERNAL_MODEL ! loop over internal models UMSUBIN1.140
UMSUBIN1.141
im = INTERNAL_MODEL_LIST(i) ! internal model identifier UMSUBIN1.142
sm = SUBMODEL_FOR_IM(i) ! submodel for this internal model UMSUBIN1.143
INTERNAL_MODEL_INDEX(im)=i ! sequence no. for STASH arrays UMSUBIN1.144
UMSUBIN1.145
if(sm.ne.sm_prev) then ! new submodel UMSUBIN1.146
UMSUBIN1.147
N_SUBMODEL_PARTITION = N_SUBMODEL_PARTITION+1 UMSUBIN1.148
SUBMODEL_PARTITION_LIST(N_SUBMODEL_PARTITION) = sm UMSUBIN1.149
UMSUBIN1.150
! Since this is a new submodel, the previous internal model must be UMSUBIN1.151
! the last internal model in its submodel partition. UMSUBIN1.152
IF(N_SUBMODEL_PARTITION.GT.1) THEN ! Not first dump UMSUBIN1.153
LAST_IM_IN_SM(im_prev) = .true. UMSUBIN1.154
ENDIF UMSUBIN1.155
UMSUBIN1.156
endif ! test on new submodel UMSUBIN1.157
SUBMODEL_FOR_SM(IM) = N_SUBMODEL_PARTITION GSM2F404.181
UMSUBIN1.158
SUBMODEL_PARTITION_INDEX(im)=sm UMSUBIN1.159
N_INTERNAL_FOR_SM(sm)=N_INTERNAL_FOR_SM(sm)+1 UMSUBIN1.160
UMSUBIN1.161
im_prev=im UMSUBIN1.162
sm_prev=sm UMSUBIN1.163
UMSUBIN1.164
enddo ! i=1,N_INTERNAL_MODEL UMSUBIN1.165
UMSUBIN1.166
LAST_IM_IN_SM(im) = .true. ! last im in list is last im in sm UMSUBIN1.167
UMSUBIN1.168
! UMSUBIN1.169
! 5. Check calculated dimensions against parameter maxima. UMSUBIN1.170
UMSUBIN1.171
if(N_SUBMODEL_PARTITION.gt.N_SUBMODEL_PARTITION_MAX) then UMSUBIN1.172
write(6,*) 'UM_Submodel_In: FATAL ERROR. Too many submodels =', UMSUBIN1.173
* N_SUBMODEL_PARTITION, UMSUBIN1.174
* ' You need to increase N_SUBMODEL_PARTITION_MAX' UMSUBIN1.175
ErrorStatus=1 ! Set error flag UMSUBIN1.176
endif UMSUBIN1.177
! UMSUBIN1.178
C Need a copy of No of submodels for use by TYPD1. GSM2F403.212
ALT_N_SUBMODEL_PARTITION=N_SUBMODEL_PARTITION GSM2F403.213
GSM2F403.214
if (ALT_N_SUBMODEL_PARTITION_MAX.NE.N_SUBMODEL_PARTITION_MAX)THEN GSM2F403.215
write(6,*)'UM_Submodel_In: Mismatch in parameters ' GSM2F403.216
WRITE(6,*)'N_SUBMODEL_PARTITION_MAX and ' GSM2F403.217
WRITE(6,*)'ALT_N_SUBMODEL_PARTITION_MAX. ' GSM2F403.218
WRITE(6,*)'They should be identical ' GSM2F403.219
ErrorStatus=1 GSM2F403.220
endif GSM2F403.221
return UMSUBIN1.179
end UMSUBIN1.180
*ENDIF UMSUBIN1.181