SUBROUTINE SINDX(NRECS) 3SINDX1.7
IMPLICIT NONE SINDX1.8
SINDX1.9
! Description: SINDX1.10
! The STASH list (LIST_S) is input to this routine. The output from SINDX1.11
! the routine is the STASH index (INDX_S) consistent with LIST_S. SINDX1.12
! Called by STPROC, DUPLIC. SINDX1.13
! SINDX1.14
! Method: SINDX1.15
! Before this routine is executed, LIST_S has been ordered by SINDX1.16
! model, section, item, input code. In this routine, INDX_S is SINDX1.17
! set up as follows: SINDX1.18
! INDX_S(1,m,s,i)= position of 1st. occurrence of m,s,i in LIST_S SINDX1.19
! INDX_S(2,m,s,i)= no. of occurrences of m,s,i in LIST_S SINDX1.20
! SINDX1.21
! Current code owner: S.J.Swarbrick SINDX1.22
! SINDX1.23
! History: SINDX1.24
! Version Date Comment SINDX1.25
! ======= ==== ======= SINDX1.26
! 3.5 Mar. 95 Original code. S.J.Swarbrick SINDX1.27
! SINDX1.28
! Code description: SINDX1.29
! FORTRAN 77 + common Fortran 90 extensions. SINDX1.30
! Written to UM programming standards version 7. SINDX1.31
! SINDX1.32
! System component covered: SINDX1.33
! System task: Sub-Models Project SINDX1.34
! SINDX1.35
! Global variables: SINDX1.36
SINDX1.37
*CALL CSUBMODL 
SINDX1.38
*CALL VERSION SINDX1.39
*CALL CSTASH GRB0F401.24
*CALL STEXTEND SINDX1.41
*CALL STPARAM SINDX1.42
SINDX1.43
! Subroutine Arguments: SINDX1.44
SINDX1.45
! Scalar Argument with intent(in): SINDX1.46
SINDX1.47
INTEGER NRECS ! No. of records in LIST_S SINDX1.48
SINDX1.49
! Local variables: SINDX1.50
SINDX1.51
INTEGER II SINDX1.52
INTEGER IITM SINDX1.53
INTEGER IM SINDX1.54
INTEGER IREC SINDX1.55
INTEGER IS SINDX1.56
INTEGER ISEC SINDX1.57
INTEGER LSTART SINDX1.58
INTEGER MODL SINDX1.59
SINDX1.60
! Local arrays: SINDX1.61
SINDX1.62
!- End of Header ------------------------------------------------------- SINDX1.63
SINDX1.64
SINDX1.65
! Initialise Index array SINDX1.66
SINDX1.67
DO IM = 1,N_INTERNAL_MODEL_MAX SINDX1.68
DO IS = 0,NSECTP SINDX1.69
DO II= 1,NITEMP SINDX1.70
INDX_S(1,IM,IS,II)=0 SINDX1.71
INDX_S(2,IM,IS,II)=0 SINDX1.72
END DO SINDX1.73
END DO SINDX1.74
END DO SINDX1.75
SINDX1.76
! Set up index SINDX1.77
SINDX1.78
IF(NRECS.GE.1) THEN SINDX1.79
SINDX1.80
MODL=LIST_S(st_model_code ,1) SINDX1.81
ISEC=LIST_S(st_sect_no_code,1) SINDX1.82
IITM=LIST_S(st_item_code ,1) SINDX1.83
SINDX1.84
LSTART=1 SINDX1.85
SINDX1.86
INDX_S(2,MODL,ISEC,IITM) = 1 SINDX1.87
INDX_S(1,MODL,ISEC,IITM) = 1 SINDX1.88
SINDX1.89
IF(NRECS.GE.2) THEN ! More than one record in LIST_S SINDX1.90
SINDX1.91
DO IREC=2,NRECS SINDX1.92
IF((LIST_S(st_model_code ,IREC).EQ.MODL).AND. ! Same model, SINDX1.93
& (LIST_S(st_sect_no_code,IREC).EQ.ISEC).AND. ! sec,item, SINDX1.94
& (LIST_S(st_item_code ,IREC).EQ.IITM))THEN ! as before SINDX1.95
SINDX1.96
LSTART=LSTART+1 SINDX1.97
SINDX1.98
INDX_S(2,MODL,ISEC,IITM) = INDX_S(2,MODL,ISEC,IITM)+1 SINDX1.99
SINDX1.100
ELSE ! New model, section, item SINDX1.101
SINDX1.102
MODL=LIST_S(st_model_code ,IREC) SINDX1.103
ISEC=LIST_S(st_sect_no_code,IREC) SINDX1.104
IITM=LIST_S(st_item_code ,IREC) SINDX1.105
SINDX1.106
LSTART=LSTART+1 SINDX1.107
SINDX1.108
INDX_S(1,MODL,ISEC,IITM) = LSTART SINDX1.109
INDX_S(2,MODL,ISEC,IITM) = 1 SINDX1.110
SINDX1.111
END IF SINDX1.112
END DO SINDX1.113
SINDX1.114
ELSE ! Only one record SINDX1.115
SINDX1.116
INDX_S(1,LIST_S(st_model_code ,1), SINDX1.117
& LIST_S(st_sect_no_code,1), SINDX1.118
& LIST_S(st_item_code ,1)) = 1 SINDX1.119
SINDX1.120
INDX_S(2,LIST_S(st_model_code ,1), SINDX1.121
& LIST_S(st_sect_no_code,1), SINDX1.122
& LIST_S(st_item_code ,1)) = 1 SINDX1.123
SINDX1.124
END IF SINDX1.125
END IF SINDX1.126
SINDX1.127
RETURN SINDX1.128
END SINDX1.129
*ENDIF SINDX1.130