SUBROUTINE ORDER(NRECS) 3ORDER1.7
IMPLICIT NONE ORDER1.8
ORDER1.9
! Description: ORDER1.10
! Bubble sort of STASH list by model/section/item/input code ORDER1.11
! ORDER1.12
! Method: ORDER1.13
! Loops through records in LIST_S (STASH list) and compares values of ORDER1.14
! model number, then section, then item, then input code. If the values ORDER1.15
! are not in descending order for any one of these categories, ORDER1.16
! the records are interchanged. A logical LSWAP is used to ORDER1.17
! determine when the sort is complete. ORDER1.18
! Called by DUPLIC, STPROC ORDER1.19
! ORDER1.20
! Current code owner: S.J.Swarbrick ORDER1.21
! ORDER1.22
! History: ORDER1.23
! Version Date Comment ORDER1.24
! ======= ==== ======= ORDER1.25
! 3.5 Mar. 95 Original code. S.J.Swarbrick ORDER1.26
! ORDER1.27
! Code description: ORDER1.28
! FORTRAN 77 + common Fortran 90 extensions. ORDER1.29
! Written to UM programming standards version 7. ORDER1.30
! ORDER1.31
! System component covered: ORDER1.32
! System task: Sub-Models Project ORDER1.33
! ORDER1.34
! Global variables ORDER1.35
! ORDER1.36
ORDER1.37
*CALL CSUBMODL 
ORDER1.38
*CALL VERSION ORDER1.39
*CALL CSTASH GRB0F401.8
*CALL STEXTEND ORDER1.41
*CALL STPARAM ORDER1.42
ORDER1.43
! Subroutine arguments ORDER1.44
! Scalar argument with intent(in): ORDER1.45
INTEGER NRECS ! No. of records in STASH list ORDER1.46
ORDER1.47
! Local scalars: ORDER1.48
ORDER1.49
INTEGER LIST_T ! Used for swapping values in consecutive records ORDER1.50
LOGICAL LSWAP ! If TRUE, order not complete ORDER1.51
INTEGER I ORDER1.52
INTEGER IREC ORDER1.53
INTEGER IREC1 ORDER1.54
ORDER1.55
!- End of Header ------------------------------------------------------ ORDER1.56
ORDER1.57
LSWAP=.TRUE. ORDER1.58
ORDER1.59
100 CONTINUE ! return point for order loop ORDER1.60
ORDER1.61
LSWAP=.FALSE. ORDER1.62
ORDER1.63
! Loop over records in LIST_S ORDER1.64
ORDER1.65
DO IREC=NRECS-1,1,-1 ORDER1.66
IREC1=IREC+1 ORDER1.67
ORDER1.68
! Sort by internal model ORDER1.69
ORDER1.70
IF(LIST_S(st_model_code,IREC).GT. ORDER1.71
& LIST_S(st_model_code,IREC1)) THEN ORDER1.72
LSWAP=.TRUE. ORDER1.73
DO I=1,NELEMP+1 ORDER1.74
LIST_T=LIST_S(I,IREC) ORDER1.75
LIST_S(I,IREC)=LIST_S(I,IREC1) ORDER1.76
LIST_S(I,IREC1)=LIST_T ORDER1.77
END DO ORDER1.78
END IF ORDER1.79
ORDER1.80
! Sort by section for same internal model ORDER1.81
ORDER1.82
IF( (LIST_S(st_model_code,IREC).EQ. ORDER1.83
& LIST_S(st_model_code,IREC1)).AND. ORDER1.84
& (LIST_S(st_sect_no_code,IREC).GT. ORDER1.85
& LIST_S(st_sect_no_code,IREC1)) ) THEN ORDER1.86
LSWAP=.TRUE. ORDER1.87
DO I=1,NELEMP+1 ORDER1.88
LIST_T=LIST_S(I,IREC) ORDER1.89
LIST_S(I,IREC)=LIST_S(I,IREC1) ORDER1.90
LIST_S(I,IREC1)=LIST_T ORDER1.91
END DO ORDER1.92
END IF ORDER1.93
ORDER1.94
! Sort by item for same model, section ORDER1.95
ORDER1.96
IF( (LIST_S(st_model_code,IREC).EQ. ORDER1.97
& LIST_S(st_model_code,IREC1)).AND. ORDER1.98
& (LIST_S(st_sect_no_code,IREC).EQ. ORDER1.99
& LIST_S(st_sect_no_code,IREC1)).AND. ORDER1.100
& (LIST_S(st_item_code,IREC).GT. ORDER1.101
& LIST_S(st_item_code,IREC1)) ) THEN ORDER1.102
LSWAP=.TRUE. ORDER1.103
DO I=1,NELEMP+1 ORDER1.104
LIST_T=LIST_S(I,IREC) ORDER1.105
LIST_S(I,IREC)=LIST_S(I,IREC1) ORDER1.106
LIST_S(I,IREC1)=LIST_T ORDER1.107
END DO ORDER1.108
END IF ORDER1.109
ORDER1.110
! Sort by input code when model, section, item are correct ORDER1.111
ORDER1.112
IF( (LIST_S(st_input_code,IREC).LT. ORDER1.113
& LIST_S(st_input_code,IREC1)).AND. ORDER1.114
& (LIST_S(st_model_code,IREC).EQ. ORDER1.115
& LIST_S(st_model_code,IREC1)).AND. ORDER1.116
& (LIST_S(st_item_code,IREC).EQ. ORDER1.117
& LIST_S(st_item_code,IREC1)).AND. ORDER1.118
& (LIST_S(st_sect_no_code,IREC).EQ. ORDER1.119
& LIST_S(st_sect_no_code,IREC1)) ) THEN ORDER1.120
LSWAP=.TRUE. ORDER1.121
DO I=1,NELEMP+1 ORDER1.122
LIST_T=LIST_S(I,IREC) ORDER1.123
LIST_S(I,IREC)=LIST_S(I,IREC1) ORDER1.124
LIST_S(I,IREC1)=LIST_T ORDER1.125
END DO ORDER1.126
END IF ORDER1.127
ORDER1.128
END DO ! Loop over records ORDER1.129
ORDER1.130
IF (LSWAP) GOTO 100 ORDER1.131
ORDER1.132
RETURN ORDER1.133
END ORDER1.134
*ENDIF ORDER1.135