Skip to content

Commit 5eb338d

Browse files
author
Denis Haumont
committed
add derivatives cont
1 parent a737f9b commit 5eb338d

File tree

2 files changed

+64
-45
lines changed

2 files changed

+64
-45
lines changed

‎inv_trans.F90

+19-19
Original file line numberDiff line numberDiff line change
@@ -466,17 +466,17 @@ SUBROUTINE INV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,&
466466
ENDIF
467467
IUBOUND(1:3)=UBOUND(PGP)
468468
IF(IUBOUND(1) < NPROMA) THEN
469-
WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),NPROMA
469+
WRITE(*,*)'INV_TRANS:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),NPROMA
470470
CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGP TOO SMALL ')
471471
ENDIF
472472
IF(IUBOUND(2) < IF_GP) THEN
473-
WRITE(NOUT,*)'INV_TRANS:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),IF_GP
474-
WRITE(NOUT,*)'IF_UV_G,IF_SCALARS_G,LSCDERS,LVORGP,LDIVGP,LUVDER ',&
473+
WRITE(*,*)'INV_TRANS:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),IF_GP
474+
WRITE(*,*)'IF_UV_G,IF_SCALARS_G,LSCDERS,LVORGP,LDIVGP,LUVDER ',&
475475
& IF_UV_G,IF_SCALARS_G,LSCDERS,LVORGP,LDIVGP,LUVDER
476476
CALL ABORT_TRANS('INV_TRANS:SECOND DIMENSION OF PGP TOO SMALL ')
477477
ENDIF
478478
IF(IUBOUND(3) < NGPBLKS) THEN
479-
WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),NGPBLKS
479+
WRITE(*,*)'INV_TRANS:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),NGPBLKS
480480
CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGP TOO SMALL ')
481481
ENDIF
482482
ELSE
@@ -491,19 +491,19 @@ SUBROUTINE INV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,&
491491
ENDIF
492492
IUBOUND(1:4)=UBOUND(PGPUV)
493493
IF(IUBOUND(1) < NPROMA) THEN
494-
WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGPUV TOO SMALL ',IUBOUND(1),NPROMA
494+
WRITE(*,*)'INV_TRANS:FIRST DIM. OF PGPUV TOO SMALL ',IUBOUND(1),NPROMA
495495
CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGPUV TOO SMALL ')
496496
ENDIF
497497
IF(IUBOUND(2) /= IF_UV_G) THEN
498-
WRITE(NOUT,*)'INV_TRANS:SEC. DIM. OF PGPUV INCONSISTENT ',IUBOUND(2),IF_UV_G
498+
WRITE(*,*)'INV_TRANS:SEC. DIM. OF PGPUV INCONSISTENT ',IUBOUND(2),IF_UV_G
499499
CALL ABORT_TRANS('INV_TRANS:SEC. DIMENSION OF PGPUV INCONSISTENT ')
500500
ENDIF
501501
IF(IUBOUND(3) < IF_UV_PAR) THEN
502-
WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(3),IF_UV_PAR
502+
WRITE(*,*)'INV_TRANS:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(3),IF_UV_PAR
503503
CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGPUV TOO SMALL ')
504504
ENDIF
505505
IF(IUBOUND(4) < NGPBLKS) THEN
506-
WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(4),NGPBLKS
506+
WRITE(*,*)'INV_TRANS:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(4),NGPBLKS
507507
CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGPUV TOO SMALL ')
508508
ENDIF
509509
ENDIF
@@ -516,15 +516,15 @@ SUBROUTINE INV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,&
516516
IF(PRESENT(PGP2)) THEN
517517
IUBOUND(1:3)=UBOUND(PGP2)
518518
IF(IUBOUND(1) < NPROMA) THEN
519-
WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGP2 TOO SMALL ',IUBOUND(1),NPROMA
519+
WRITE(*,*)'INV_TRANS:FIRST DIM. OF PGP2 TOO SMALL ',IUBOUND(1),NPROMA
520520
CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGP2 TOO SMALL ')
521521
ENDIF
522522
IF(IUBOUND(2) /= IF_SC2_G) THEN
523-
WRITE(NOUT,*)'INV_TRANS:SEC. DIM. OF PGP2 INCONSISTENT ',IUBOUND(2),IF_SC2_G
523+
WRITE(*,*)'INV_TRANS:SEC. DIM. OF PGP2 INCONSISTENT ',IUBOUND(2),IF_SC2_G
524524
CALL ABORT_TRANS('INV_TRANS:SEC. DIMENSION OF PGP2 INCONSISTENT')
525525
ENDIF
526526
IF(IUBOUND(3) < NGPBLKS) THEN
527-
WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGP2 TOO SMALL ',IUBOUND(3),NGPBLKS
527+
WRITE(*,*)'INV_TRANS:THIRD DIM. OF PGP2 TOO SMALL ',IUBOUND(3),NGPBLKS
528528
CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGP2 TOO SMALL ')
529529
ENDIF
530530
ELSE
@@ -541,20 +541,20 @@ SUBROUTINE INV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,&
541541
IF(PRESENT(PGP3A)) THEN
542542
IUBOUND=UBOUND(PGP3A)
543543
IF(IUBOUND(1) < NPROMA) THEN
544-
WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGP3A TOO SMALL ',IUBOUND(1),NPROMA
544+
WRITE(*,*)'INV_TRANS:FIRST DIM. OF PGP3A TOO SMALL ',IUBOUND(1),NPROMA
545545
CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGP3A TOO SMALL ')
546546
ENDIF
547547
IF(IUBOUND(2) /= IF_SC3A_G2) THEN
548-
WRITE(NOUT,*)'INV_TRANS:SEC DIM. OF PGP3A INCONSISTENT ',IUBOUND(2),IF_SC3A_G2
548+
WRITE(*,*)'INV_TRANS:SEC DIM. OF PGP3A INCONSISTENT ',IUBOUND(2),IF_SC3A_G2
549549
CALL ABORT_TRANS('INV_TRANS:SEC. DIMENSION OF PGP3A INCONSISTENT ')
550550
ENDIF
551551
IF(IUBOUND(3) /= IF_SC3A_G3 ) THEN
552-
WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGP3A INCONSISTENT ',&
552+
WRITE(*,*)'INV_TRANS:THIRD DIM. OF PGP3A INCONSISTENT ',&
553553
& IUBOUND(3),IF_SC3A_G3
554554
CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGP3A INCONSISTENT ')
555555
ENDIF
556556
IF(IUBOUND(4) < NGPBLKS) THEN
557-
WRITE(NOUT,*)'INV_TRANS:FOURTH DIM. OF PGP3A TOO SMALL ',IUBOUND(4),NGPBLKS
557+
WRITE(*,*)'INV_TRANS:FOURTH DIM. OF PGP3A TOO SMALL ',IUBOUND(4),NGPBLKS
558558
CALL ABORT_TRANS('INV_TRANS:FOURTH DIMENSION OF PGP3A TOO SMALL ')
559559
ENDIF
560560
ELSE
@@ -571,20 +571,20 @@ SUBROUTINE INV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,&
571571
IF(PRESENT(PGP3B)) THEN
572572
IUBOUND=UBOUND(PGP3B)
573573
IF(IUBOUND(1) < NPROMA) THEN
574-
WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGP3B TOO SMALL ',IUBOUND(1),NPROMA
574+
WRITE(*,*)'INV_TRANS:FIRST DIM. OF PGP3B TOO SMALL ',IUBOUND(1),NPROMA
575575
CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGP3B TOO SMALL ')
576576
ENDIF
577577
IF(IUBOUND(2) /= IF_SC3B_G2) THEN
578-
WRITE(NOUT,*)'INV_TRANS:SEC DIM. OF PGP3B INCONSISTENT ',IUBOUND(2),IF_SC3B_G2
578+
WRITE(*,*)'INV_TRANS:SEC DIM. OF PGP3B INCONSISTENT ',IUBOUND(2),IF_SC3B_G2
579579
CALL ABORT_TRANS('INV_TRANS:SEC. DIMENSION OF PGP3B INCONSISTENT ')
580580
ENDIF
581581
IF(IUBOUND(3) /= IF_SC3B_G3 ) THEN
582-
WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGP3B INCONSISTENT ',&
582+
WRITE(*,*)'INV_TRANS:THIRD DIM. OF PGP3B INCONSISTENT ',&
583583
& IUBOUND(3),IF_SC3B_G3
584584
CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGP3B INCONSISTENT ')
585585
ENDIF
586586
IF(IUBOUND(4) < NGPBLKS) THEN
587-
WRITE(NOUT,*)'INV_TRANS:FOURTH DIM. OF PGP3B TOO SMALL ',IUBOUND(4),NGPBLKS
587+
WRITE(*,*)'INV_TRANS:FOURTH DIM. OF PGP3B TOO SMALL ',IUBOUND(4),NGPBLKS
588588
CALL ABORT_TRANS('INV_TRANS:FOURTH DIMENSION OF PGP3B TOO SMALL ')
589589
ENDIF
590590
ELSE

‎inv_trans_field_api.F90

+45-26
Original file line numberDiff line numberDiff line change
@@ -75,18 +75,19 @@ SUBROUTINE INV_TRANS_FIELD_API(SPVORS,SPDIVS,SPSCALARS, &
7575
INTEGER(KIND=JPIM) :: IFLDSUV ! Number of input spectral vector fields
7676
INTEGER(KIND=JPIM) :: IFLDS ! Number of input spectral scalar fields
7777
INTEGER(KIND=JPIM) :: IFLDG ! Number of output scalar fields
78+
INTEGER(KIND=JPIM) :: KFLDG ! Size of output scalar fields array
7879
INTEGER(KIND=JPIM) :: IFLDGUV ! Number of output vector fields
79-
INTEGER(KIND=JPIM) :: KFLDGUV ! Number of output vector fields
80+
INTEGER(KIND=JPIM) :: KFLDGUV ! Size of output vector fields array
8081

81-
INTEGER(KIND=JPIM) :: OFFSETUV
82+
INTEGER(KIND=JPIM) :: OFFSET
8283
INTEGER(KIND=JPIM) :: ISPEC2 ! Size of spectral fields (truncation)
8384
INTEGER(KIND=JPIM) :: IPROMA,IGPBLKS ! Size of output grid fields
8485

8586
INTEGER(KIND=JPIM) :: JFLD ! field counter
86-
LOGICAL :: LDSCDERS ! indicating if derivatives of scalar variables are req.
87-
LOGICAL :: LDVORGP ! indicating if grid-point vorticity is req.
88-
LOGICAL :: LDDIVGP ! indicating if grid-point divergence is req.
89-
LOGICAL :: LDUVDER ! indicating if E-W derivatives of u and v are req.
87+
LOGICAL :: LDSCDERS ! indicating if derivatives of scalar variables are req.
88+
LOGICAL :: LDVORGP ! indicating if grid-point vorticity is req.
89+
LOGICAL :: LDDIVGP ! indicating if grid-point divergence is req.
90+
LOGICAL :: LDUVDER ! indicating if E-W derivatives of u and v are req.
9091

9192
#include "inv_trans.h"
9293

@@ -134,24 +135,30 @@ SUBROUTINE INV_TRANS_FIELD_API(SPVORS,SPDIVS,SPSCALARS, &
134135
ISPEC2 = SIZE(SPVORL(1)%V,1) ! Size of spectral fields
135136
IFLDSUV = SIZE(SPVORL) ! Number of input spectral vector fields
136137

137-
LDVORGP = .FALSE. ! indicating if grid-point vorticity is req.
138-
LDDIVGP = .FALSE. ! indicating if grid-point divergence is req.
139-
LDUVDER = .FALSE. ! indicating if E-W derivatives of u and v are req.
138+
LDVORGP = .FALSE.
139+
LDDIVGP = .FALSE.
140+
LDUVDER = .FALSE.
141+
LDSCDERS = .FALSE.
140142

141143
KFLDGUV = IFLDGUV
144+
145+
142146
IF (PRESENT(DUS) .AND. PRESENT(DVS)) THEN
147+
PRINT *, "DUS/DVS PRESENT"
143148
LDUVDER = .TRUE.
144149
KFLDGUV = KFLDGUV + 2 * IFLDGUV
145150
ENDIF
146151
IF (PRESENT(VORS)) THEN
152+
PRINT *, "VORS PRESENT"
147153
LDVORGP = .TRUE.
148154
KFLDGUV = KFLDGUV + IFLDGUV
149155
ENDIF
150156
IF (PRESENT(DIVS)) THEN
157+
PRINT *, "DIVS PRESENT"
151158
LDUVDER = .TRUE.
152159
KFLDGUV = KFLDGUV + IFLDGUV
153160
ENDIF
154-
161+
155162
! Allocate vector field input in spectral space
156163
ALLOCATE(ZSPVOR(ISPEC2,IFLDSUV))
157164
ALLOCATE(ZSPDIV(ISPEC2,IFLDSUV))
@@ -201,12 +208,19 @@ SUBROUTINE INV_TRANS_FIELD_API(SPVORS,SPDIVS,SPSCALARS, &
201208

202209
ISPEC2 = SIZE(SPSCALARL(1)%V,1)
203210
IFLDS = SIZE(SPSCALARL) ! Number of input scalar fields in spectral space
211+
212+
KFLDG = IFLDG
213+
IF (PRESENT(DSCALARS) .AND. PRESENT(DSCALARS_NS)) THEN
214+
PRINT *, "DSCALARS/DSCALARS_NS PRESENT"
215+
LDSCDERS = .TRUE.
216+
KFLDG = KFLDG + 2 * IFLDG
217+
ENDIF
204218

205219
! Allocate scalar field input in spectral space
206220
ALLOCATE(ZSPSCALAR(ISPEC2,IFLDS))
207221

208222
! Allocate scalar field output in grid space
209-
ALLOCATE(ZGP(IPROMA,IFLDG,IGPBLKS))
223+
ALLOCATE(ZGP(IPROMA,KFLDG,IGPBLKS))
210224

211225
! Copy scalar spectral fields to temporary arrays (1D copy thanks to FIELD VIEW)
212226
DO JFLD=1,IFLDS
@@ -217,12 +231,6 @@ SUBROUTINE INV_TRANS_FIELD_API(SPVORS,SPDIVS,SPSCALARS, &
217231
ALLOCATE(ZGP(0,IFLDG,0),ZSPSCALAR(0,0))
218232
ENDIF
219233

220-
! 3. Derived output management (vorticity, divergence, derivatives)
221-
222-
LDSCDERS = .FALSE. ! indicating if derivatives of scalar variables are req.
223-
224-
IF (PRESENT(DSCALARS) .AND. PRESENT(DSCALARS_NS)) LDSCDERS = .TRUE.
225-
226234
! 3. CALL INV_TRANS
227235

228236
IF (PRESENT (FSPGL_PROC)) THEN
@@ -243,35 +251,46 @@ SUBROUTINE INV_TRANS_FIELD_API(SPVORS,SPDIVS,SPSCALARS, &
243251
ENDDO
244252

245253
! copy derivatives, divergences and vorticities back from temporary vector arrays
246-
OFFSETUV = IFLDGUV
254+
OFFSET = IFLDGUV
247255
IF (LDUVDER) THEN
248256
DO JFLD=1,IFLDGUV
249-
DUL(JFLD)%V(:,:) = ZGPUV(:,OFFSETUV+JFLD,1,:)
250-
DVL(JFLD)%V(:,:) = ZGPUV(:,OFFSETUV+JFLD,2,:)
257+
DUL(JFLD)%V(:,:) = ZGPUV(:,OFFSET+JFLD,1,:)
258+
DVL(JFLD)%V(:,:) = ZGPUV(:,OFFSET+JFLD,2,:)
251259
ENDDO
252-
OFFSETUV = OFFSETUV + IFLDGUV
260+
OFFSET = OFFSET + IFLDGUV
253261
ENDIF
254262

255263
IF (LDVORGP) THEN
256264
DO JFLD=1,IFLDGUV
257-
VORL(JFLD)%V(:,:) = ZGPUV(:,OFFSETUV+JFLD,1,:)
265+
VORL(JFLD)%V(:,:) = ZGPUV(:,OFFSET+JFLD,1,:)
258266
ENDDO
259-
OFFSETUV = OFFSETUV + IFLDGUV
267+
OFFSET = OFFSET + IFLDGUV
260268
ENDIF
261269

262270
IF (LDDIVGP) THEN
263271
DO JFLD=1,IFLDGUV
264-
DIVL(JFLD)%V(:,:) = ZGPUV(:,OFFSETUV+JFLD,1,:)
272+
DIVL(JFLD)%V(:,:) = ZGPUV(:,OFFSET+JFLD,1,:)
265273
ENDDO
266-
OFFSETUV = OFFSETUV + IFLDGUV
274+
OFFSET = OFFSET + IFLDGUV
267275
ENDIF
268276

269-
270277
! Copy scalar fields back from temporary scalar arrays
271278
DO JFLD=1,IFLDG
272279
SCALARL(JFLD)%V(:,:) = ZGP(:,JFLD,:)
273280
ENDDO
274281

282+
OFFSET = IFLDG
283+
284+
IF (LDSCDERS) THEN
285+
DO JFLD=1,IFLDG
286+
DSCALARL(JFLD)%V(:,:) = ZGP(:,OFFSET+JFLD,:)
287+
ENDDO
288+
DO JFLD=1,IFLDG
289+
DSCALARS_NL(JFLD)%V(:,:) = ZGP(:,OFFSET+JFLD,:)
290+
ENDDO
291+
OFFSET = OFFSET + IFLDGUV
292+
ENDIF
293+
275294
END SUBROUTINE INV_TRANS_FIELD_API
276295

277296
END MODULE INV_TRANS_FIELD_API_MODULE

0 commit comments

Comments
 (0)