Newer
Older
MODULE MODE_MNH_ZWORK
IMPLICIT NONE
INTEGER, SAVE :: IIB,IJB,IKB ! Begining useful area in x,y,z directions
INTEGER, SAVE :: IIE,IJE,IKE ! End useful area in x,y,z directions
!
INTEGER,SAVE :: IJS,IJN, IIW,IIA
!
INTEGER, SAVE :: IIU,IJU,IKU
LOGICAL, SAVE :: GWEST , GEAST
LOGICAL, SAVE :: GSOUTH , GNORTH
LOGICAL, SAVE :: GFIRST_CALL_MNH_ALLOC_ZWORK = .TRUE.
!
REAL, SAVE, ALLOCATABLE , DIMENSION(:,:) :: ZPSRC_HALO2_WEST
REAL, SAVE, ALLOCATABLE , DIMENSION(:,:) :: ZPSRC_HALO2_SOUTH
!$acc declare mirror(ZPSRC_HALO2_WEST,ZPSRC_HALO2_SOUTH)
REAL, SAVE, ALLOCATABLE , DIMENSION(:,:,:) :: ZUNIT3D
!$acc declare mirror(ZUNIT3D)
INTEGER :: JPMAX_T3D = 35
INTEGER , ALLOCATABLE, DIMENSION (:) :: NT3D_POOL
INTEGER :: NT3D_TOP , NT3D_TOP_MAX = 0
REAL , ALLOCATABLE, DIMENSION(:,:,:,:) , TARGET :: ZT3D_A1,ZT3D_A2,ZT3D_A3,ZT3D_A4
REAL , POINTER , DIMENSION(:,:,:,:) :: ZT3D
!$acc declare mirror(ZT3D_A1,ZT3D_A2,ZT3D_A3,ZT3D_A4)
TYPE TMODEL
REAL , POINTER, DIMENSION(:,:,:,:) :: X
END TYPE TMODEL
TYPE(TMODEL) , DIMENSION(10) :: MODEL
CONTAINS
SUBROUTINE MNH_ALLOC_ZWORK(IMODEL)
USE MODE_TOOLS_ll, ONLY : LWEST_ll,LEAST_ll, LSOUTH_ll, LNORTH_ll
USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
USE MODD_DIM_n, ONLY : NKMAX
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
IMPLICIT NONE
INTEGER :: IMODEL
INTEGER :: JI
IF (GFIRST_CALL_MNH_ALLOC_ZWORK) THEN
GFIRST_CALL_MNH_ALLOC_ZWORK = .FALSE.
!
! Array dim
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=NKMAX + 2* JPVEXT
!
! Computation bound
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IJS=IJB
IJN=IJE
IIW=IIB
IIA=IIE
IKB = 1 + JPVEXT
IKE = NKMAX + JPVEXT
!
! Lateral boundary
!
GWEST = LWEST_ll()
GEAST = LEAST_ll()
GSOUTH=LSOUTH_ll()
GNORTH=LNORTH_ll()
!
! Work array
!
ALLOCATE (ZPSRC_HALO2_WEST(IJU,IKU))
ALLOCATE (ZPSRC_HALO2_SOUTH(IIU,IKU))
ALLOCATE (ZUNIT3D(IIU,IJU,IKU))
ALLOCATE (ZT3D_A1(IIU,IJU,IKU,JPMAX_T3D))
MODEL(1)%X => ZT3D_A1
ZT3D => MODEL(1)%X
ALLOCATE (NT3D_POOL(JPMAX_T3D))
NT3D_TOP = 0
DO JI = 1, JPMAX_T3D
NT3D_POOL(JI) = JI
END DO
!$acc kernels
ZPSRC_HALO2_WEST = XUNDEF
ZPSRC_HALO2_SOUTH = XUNDEF
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
!$acc end kernels
!$acc update host (ZPSRC_HALO2_WEST,ZPSRC_HALO2_SOUTH)
!$acc update host (ZUNIT3D)
!$acc update host (ZT3D)
END IF
END SUBROUTINE MNH_ALLOC_ZWORK
SUBROUTINE MNH_GET_ZT3D_N0(KTEMP)
IMPLICIT NONE
INTEGER :: KTEMP
IF (NT3D_TOP == JPMAX_T3D ) THEN
print*," MNH_GET_ZT3D JPMAX_T3D OVER FLOW=", JPMAX_T3D
call ABORT()
ELSE
NT3D_TOP = NT3D_TOP + 1
KTEMP = NT3D_POOL(NT3D_TOP)
NT3D_POOL(NT3D_TOP) = -1
IF ( NT3D_TOP > NT3D_TOP_MAX ) THEN
NT3D_TOP_MAX = NT3D_TOP
print*," MNH_GET_ZT3D NT3D_TOP_MAX=", NT3D_TOP_MAX , "KTEMP=",KTEMP
END IF
ENDIF
END SUBROUTINE MNH_GET_ZT3D_N0
SUBROUTINE MNH_GET_ZT3D(KTEMP1,KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9,KTEMP10)
IMPLICIT NONE
INTEGER :: KTEMP1
INTEGER,OPTIONAL :: KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9,KTEMP10
CALL MNH_GET_ZT3D_N0(KTEMP1)
IF (PRESENT(KTEMP2)) CALL MNH_GET_ZT3D_N0(KTEMP2)
IF (PRESENT(KTEMP3)) CALL MNH_GET_ZT3D_N0(KTEMP3)
IF (PRESENT(KTEMP4)) CALL MNH_GET_ZT3D_N0(KTEMP4)
IF (PRESENT(KTEMP5)) CALL MNH_GET_ZT3D_N0(KTEMP5)
IF (PRESENT(KTEMP6)) CALL MNH_GET_ZT3D_N0(KTEMP6)
IF (PRESENT(KTEMP7)) CALL MNH_GET_ZT3D_N0(KTEMP7)
IF (PRESENT(KTEMP8)) CALL MNH_GET_ZT3D_N0(KTEMP8)
IF (PRESENT(KTEMP9)) CALL MNH_GET_ZT3D_N0(KTEMP9)
IF (PRESENT(KTEMP10)) CALL MNH_GET_ZT3D_N0(KTEMP10)
END SUBROUTINE MNH_GET_ZT3D
SUBROUTINE MNH_REL_ZT3D_N0(KTEMP)
IMPLICIT NONE
INTEGER :: KTEMP
IF ( ( NT3D_TOP > JPMAX_T3D ) .OR. ( NT3D_TOP < 1 ) ) THEN
print*," MNH_REL_ZT3D NT3D_TOP OVER FLOW NT3D_TOP=", NT3D_TOP
call ABORT()
ELSE
NT3D_POOL(NT3D_TOP) = KTEMP
!print*," MNH_REL_ZT3D NT3D_TOP=", NT3D_TOP , "KTEMP=",KTEMP
NT3D_TOP = NT3D_TOP - 1
ENDIF
END SUBROUTINE MNH_REL_ZT3D_N0
SUBROUTINE MNH_REL_ZT3D(KTEMP1,KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9,KTEMP10)
IMPLICIT NONE
INTEGER :: KTEMP1
INTEGER,OPTIONAL :: KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9,KTEMP10
CALL MNH_REL_ZT3D_N0(KTEMP1)
IF (PRESENT(KTEMP2)) CALL MNH_REL_ZT3D_N0(KTEMP2)
IF (PRESENT(KTEMP3)) CALL MNH_REL_ZT3D_N0(KTEMP3)
IF (PRESENT(KTEMP4)) CALL MNH_REL_ZT3D_N0(KTEMP4)
IF (PRESENT(KTEMP5)) CALL MNH_REL_ZT3D_N0(KTEMP5)
IF (PRESENT(KTEMP6)) CALL MNH_REL_ZT3D_N0(KTEMP6)
IF (PRESENT(KTEMP7)) CALL MNH_REL_ZT3D_N0(KTEMP7)
IF (PRESENT(KTEMP8)) CALL MNH_REL_ZT3D_N0(KTEMP8)
IF (PRESENT(KTEMP9)) CALL MNH_REL_ZT3D_N0(KTEMP9)
IF (PRESENT(KTEMP10)) CALL MNH_REL_ZT3D_N0(KTEMP10)
END SUBROUTINE MNH_REL_ZT3D
END MODULE MODE_MNH_ZWORK