Skip to content

Commit 9b31ae0

Browse files
author
Denis Haumont
committed
separated file for debug
1 parent 27e1814 commit 9b31ae0

4 files changed

+266
-256
lines changed

‎compile.sh

+1-1
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ do
88

99
x=inv_trans.$f90.x
1010
rm $x
11-
$f90 -g -o $x -O0 parkind1.F90 field_module.F90 inv_trans.F90 inv_trans_field_api.F90 main.F90
11+
$f90 -g -o $x -O0 parkind1.F90 field_module.F90 inv_trans.F90 print_debug_field_api.F90 inv_trans_field_api.F90 main.F90
1212
./$x
1313

1414
done

‎field_module.F90

-68
Original file line numberDiff line numberDiff line change
@@ -311,74 +311,6 @@ FUNCTION LS (YLFL, LDACC)
311311
ENDDO
312312

313313
END FUNCTION LS
314-
315-
SUBROUTINE PRINT_DEBUG_FIELDS(YLFL, FIELD_NAME, DIM_NAMES)
316-
TYPE (FIELD_BASIC_PTR) :: YLFL (:)
317-
INTEGER(KIND=JPIM) :: JFLD
318-
INTEGER(KIND=JPIM) :: ILBOUNDS (5), IUBOUNDS (5)
319-
CHARACTER(LEN=*) :: FIELD_NAME
320-
CHARACTER(LEN=*), OPTIONAL :: DIM_NAMES(:)
321-
INTEGER :: N_DIMS
322-
323-
N_DIMS = 0
324-
325-
IF (PRESENT(DIM_NAMES)) THEN
326-
N_DIMS = SIZE(DIM_NAMES)
327-
ENDIF
328-
329-
IF (N_DIMS == 1 ) THEN
330-
WRITE (*, "(A16,8X,A2, A4,A2)") &
331-
& FIELD_NAME, "| ", DIM_NAMES(1), " |"
332-
ELSE IF (N_DIMS == 2 ) THEN
333-
WRITE (*, "(A16,8X,A2, A4,A3, A4,A2)") &
334-
& FIELD_NAME, "| ", DIM_NAMES(1), " | ", DIM_NAMES(2), " |"
335-
ELSE IF (N_DIMS == 3 ) THEN
336-
WRITE (*, "(A16,8X,A2, A4,A3, A4,A3,A4, A2)") &
337-
& FIELD_NAME, "| ", &
338-
& DIM_NAMES(1), " | ", DIM_NAMES(2), " | ", DIM_NAMES(3), " |"
339-
340-
ENDIF
341-
342-
DO JFLD = 1, SIZE (YLFL)
343-
344-
SELECT TYPE (YLF => YLFL (JFLD)%PTR)
345-
CLASS IS (FIELD_1RB)
346-
CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
347-
IF (N_DIMS == 2 ) THEN
348-
WRITE (*,"(A1, I3, A1, 1X, A9, 9X, &
349-
& A1, 1X,I4, A10)") &
350-
& "[",JFLD, "]", "FIELD_1RB",&
351-
& "|", IUBOUNDS(1)-ILBOUNDS(1) + 1, ' | (1)| '
352-
ENDIF
353-
CLASS IS (FIELD_2RB)
354-
CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
355-
IF (N_DIMS == 3 ) THEN
356-
WRITE (*,"(A1, I3, A1, 1X, A9, 9X,&
357-
& A2, I4, A10, I4 ,A2)") &
358-
& "[",JFLD, "]", "FIELD_2RB", &
359-
& "| ", IUBOUNDS(1)-ILBOUNDS(1) + 1, ' | (1)| ', IUBOUNDS(2)-ILBOUNDS(2) + 1," |"
360-
ELSE IF (N_DIMS == 2 ) THEN
361-
WRITE (*,"(A1, I3, A1, 1X, A9, 9X, &
362-
& A2, I4,A3,I4,A2)") &
363-
& "[",JFLD, "]", "FIELD_2RB",&
364-
& "| ",IUBOUNDS(1)-ILBOUNDS(1) + 1, " | ",IUBOUNDS(2)-ILBOUNDS(2) + 1," |"
365-
366-
ENDIF
367-
CLASS IS (FIELD_3RB)
368-
CALL YLF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS)
369-
370-
WRITE (*,"(A1, I3, A1, 1X, A9, 9X, &
371-
& A2, I4,A3,I4,A3,I4,A2)") &
372-
& "[",JFLD, "]", "FIELD_3RB",&
373-
& "| ",IUBOUNDS(1)-ILBOUNDS(1) + 1, " | ",IUBOUNDS(2)-ILBOUNDS(2) + 1," | ",IUBOUNDS(3)-ILBOUNDS(3) + 1, " |"
374-
375-
CLASS DEFAULT
376-
STOP 1
377-
END SELECT
378-
379-
ENDDO
380-
381-
END SUBROUTINE PRINT_DEBUG_FIELDS
382314

383315
END MODULE
384316

‎inv_trans_field_api.F90

+2-187
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
MODULE INV_TRANS_FIELD_API_MODULE
22
USE FIELD_MODULE
33
USE PARKIND1 ,ONLY : JPIM ,JPRB
4+
USE PRINT_DEBUG_FIELD_API
45

56
IMPLICIT NONE
67

@@ -239,7 +240,7 @@ SUBROUTINE INV_TRANS_FIELD_API(SPVORS,SPDIVS,SPSCALARS, &
239240
! 3. CALL INV_TRANS
240241

241242
IF (LLVERBOSE) THEN
242-
CALL PRINT_DEBUG(ZSPVOR, ZSPDIV, ZSPSCALAR, ZGPUV, ZGP, &
243+
CALL PRINT_DEBUG_INV_TRANS_FIELD_API(ZSPVOR, ZSPDIV, ZSPSCALAR, ZGPUV, ZGP, &
243244
& SPVORS,SPDIVS,SPSCALARS, &
244245
& US, VS, VORS,DIVS,SCALARS, &
245246
& DUS, DVS, DSCALARS, DSCALARS_NS, &
@@ -304,190 +305,4 @@ SUBROUTINE INV_TRANS_FIELD_API(SPVORS,SPDIVS,SPSCALARS, &
304305

305306
END SUBROUTINE INV_TRANS_FIELD_API
306307

307-
SUBROUTINE PRINT_DEBUG(ZSPVOR, ZSPDIV, ZSPSCALAR, ZGPUV, ZGP, SPVORS,SPDIVS,SPSCALARS, &
308-
& US, VS, VORS,DIVS,SCALARS, &
309-
& DUS, DVS, DSCALARS, DSCALARS_NS, &
310-
& VSETUVS, VSETS, IFLDSUV,IFLDS,IFLDG,IFLDGUV,LDSCDERS,LDVORGP,LDDIVGP, LDUVDER, &
311-
& ISPEC2, NPROMA,IGPBLKS,KFLDG,KFLDGUV)
312-
313-
314-
REAL(KIND=JPRB),ALLOCATABLE :: ZSPVOR(:,:),ZSPDIV(:,:) ! Spectral vector fields (in)
315-
REAL(KIND=JPRB),ALLOCATABLE :: ZSPSCALAR(:,:) ! Spectral scalar fields (in)
316-
REAL(KIND=JPRB),ALLOCATABLE :: ZGPUV(:,:,:,:) ! Grid vector fields (out)
317-
REAL(KIND=JPRB),ALLOCATABLE :: ZGP(:,:,:) ! Grid scalar fields (out)
318-
319-
TYPE(FIELD_BASIC_PTR),OPTIONAL :: SPVORS(:), SPDIVS(:) !Spectral vector fields : vorticity and divergence fields (in)
320-
TYPE(FIELD_BASIC_PTR),OPTIONAL :: SPSCALARS(:) !Spectral scalar fields (in)
321-
322-
TYPE(FIELD_BASIC_PTR),OPTIONAL :: US(:),VS(:) !Grid vector fields (out)
323-
TYPE(FIELD_BASIC_PTR),OPTIONAL :: VORS(:),DIVS(:) !Grid vector fields :vorticity and divergence (out)
324-
TYPE(FIELD_BASIC_PTR),OPTIONAL :: SCALARS(:) !Grid scalar fields (out)
325-
326-
TYPE(FIELD_BASIC_PTR),OPTIONAL :: DUS(:),DVS(:) !Grid vector fields derivatives EW (out)
327-
TYPE(FIELD_BASIC_PTR),OPTIONAL :: DSCALARS(:), DSCALARS_NS(:) !Grid scalar fields derivatives NS(out)
328-
329-
INTEGER(KIND=JPIM),OPTIONAL :: VSETUVS(:) !Meta data vector fields
330-
INTEGER(KIND=JPIM),OPTIONAL :: VSETS(:) !Meta data scalar fields
331-
332-
333-
INTEGER(KIND=JPIM), INTENT(IN) :: IFLDSUV ! Number of input spectral vector fields
334-
INTEGER(KIND=JPIM), INTENT(IN) :: IFLDS ! Number of input spectral scalar fields
335-
INTEGER(KIND=JPIM), INTENT(IN) :: IFLDG ! Number of output scalar fields
336-
INTEGER(KIND=JPIM), INTENT(IN) :: KFLDG ! Size of output scalar fields array
337-
INTEGER(KIND=JPIM), INTENT(IN) :: IFLDGUV ! Number of output vector fields
338-
INTEGER(KIND=JPIM), INTENT(IN) :: KFLDGUV ! Size of output vector fields array
339-
340-
INTEGER(KIND=JPIM), INTENT(IN) :: ISPEC2 ! Size of spectral fields (truncation)
341-
INTEGER(KIND=JPIM), INTENT(IN) :: NPROMA,IGPBLKS ! Size of NPROMA and number of blocs
342-
343-
LOGICAL, INTENT(IN) :: LDSCDERS ! indicating if derivatives of scalar variables are req.
344-
LOGICAL, INTENT(IN) :: LDVORGP ! indicating if grid-point vorticity is req.
345-
LOGICAL, INTENT(IN) :: LDDIVGP ! indicating if grid-point divergence is req.
346-
LOGICAL , INTENT(IN) :: LDUVDER ! indicating if E-W derivatives of u and v are req.
347-
348-
CALL PRINT_DEBUG_HEADER("DIMENSIONS")
349-
350-
WRITE(*,'(A11,I4,A2)') "NPROMA | ", NPROMA, ' |'
351-
WRITE(*,'(A11,I4,A2)') "NBLKS | ", IGPBLKS, ' |'
352-
WRITE(*,'(A11,I4,A2)') "NSPECS | ", ISPEC2, ' |'
353-
WRITE(*,'(A11,L4,A2)') "LDUVDER | ", LDUVDER, ' |'
354-
WRITE(*,'(A11,L4,A2)') "LDVORGP | ", LDVORGP, ' |'
355-
WRITE(*,'(A11,L4,A2)') "LDDIVGP | ", LDDIVGP, ' |'
356-
WRITE(*,'(A11,L4,A2)') "LDSCDERS | ", LDSCDERS, ' |'
357-
CALL PRINT_DEBUG_FOOTER()
358-
359-
CALL PRINT_DEBUG_HEADER("Input spectral vector fields:", SIZE(SPVORS))
360-
361-
IF (PRESENT(SPVORS)) THEN
362-
CALL PRINT_DEBUG_FIELDS(SPVORS, "SPVORS", (/"NSPECS ", "NLEV "/))
363-
CALL PRINT_DEBUG_SUM(IFLDSUV)
364-
ENDIF
365-
366-
IF (PRESENT(SPVORS)) THEN
367-
CALL PRINT_DEBUG_FIELDS(SPDIVS, "SPDIVS", (/"NSPECS ", "NLEV "/))
368-
CALL PRINT_DEBUG_SUM(IFLDSUV)
369-
ENDIF
370-
371-
CALL PRINT_DEBUG_SEPARATOR()
372-
CALL PRINT_DEBUG_2D(ZSPVOR, "ZSPVOR", "| NSPECS | NFIELDS|")
373-
CALL PRINT_DEBUG_2D(ZSPDIV, "ZSPDIV")
374-
375-
CALL PRINT_DEBUG_HEADER("Input spectral scalar fields:", SIZE(SPSCALARS))
376-
377-
IF (PRESENT(SPSCALARS)) THEN
378-
CALL PRINT_DEBUG_FIELDS(SPSCALARS,"SPSCALARS", (/"NSPECS ", "NLEV "/))
379-
CALL PRINT_DEBUG_SUM(IFLDS)
380-
ENDIF
381-
382-
CALL PRINT_DEBUG_SEPARATOR()
383-
CALL PRINT_DEBUG_2D(ZSPSCALAR, "ZSPSCALAR", "| NSPECS | NFIELDS|")
384-
CALL PRINT_DEBUG_FOOTER()
385-
386-
CALL PRINT_DEBUG_HEADER("Output grid-point vector fields:", SIZE(US))
387-
388-
IF (PRESENT(US)) THEN
389-
CALL PRINT_DEBUG_FIELDS(US,"US", (/"NPROMA ","NLEV ", "NBLKS "/))
390-
CALL PRINT_DEBUG_SUM(IFLDGUV)
391-
ENDIF
392-
393-
IF (PRESENT(US)) THEN
394-
CALL PRINT_DEBUG_FIELDS(US,"VS", (/"NPROMA ","NLEV ", "NBLKS "/))
395-
CALL PRINT_DEBUG_SUM(IFLDGUV)
396-
ENDIF
397-
398-
399-
IF (PRESENT(VORS)) CALL PRINT_DEBUG_FIELDS(VORS,"VORS")
400-
IF (PRESENT(DIVS)) CALL PRINT_DEBUG_FIELDS(DIVS,"DIVS")
401-
IF (PRESENT(DUS)) CALL PRINT_DEBUG_FIELDS(DUS, "DUS")
402-
IF (PRESENT(DVS)) CALL PRINT_DEBUG_FIELDS(DVS, "DVS")
403-
404-
CALL PRINT_DEBUG_SEPARATOR()
405-
CALL PRINT_DEBUG_4D(ZGPUV, "ZGPUV", "| NPROMA | NLEVS | NFIELDS| NBLKS |")
406-
CALL PRINT_DEBUG_FOOTER()
407-
408-
CALL PRINT_DEBUG_HEADER("Output grid-point scalar fields:", SIZE(SCALARS))
409-
IF (PRESENT(SCALARS)) CALL PRINT_DEBUG_FIELDS(SCALARS, "SCALARS", (/"NPROMA ", "NLEV ", "NBLKS "/))
410-
IF (PRESENT(DSCALARS)) CALL PRINT_DEBUG_FIELDS(DSCALARS, "DSCALARS")
411-
IF (PRESENT(DSCALARS_NS)) CALL PRINT_DEBUG_FIELDS(DSCALARS_NS,"DSCALARS_NS")
412-
413-
CALL PRINT_DEBUG_SUM(IFLDG)
414-
415-
CALL PRINT_DEBUG_SEPARATOR()
416-
CALL PRINT_DEBUG_3D(ZGP, "ZGP", "| NPROMA | NLEVS | NBLKS |")
417-
CALL PRINT_DEBUG_FOOTER()
418-
419-
420-
END SUBROUTINE PRINT_DEBUG
421-
422-
SUBROUTINE PRINT_DEBUG_1D(A1, NAME, HEADER)
423-
REAL(KIND=JPRB),INTENT(IN) :: A1(:)
424-
CHARACTER(LEN=*), INTENT(IN) :: NAME
425-
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HEADER
426-
427-
END SUBROUTINE PRINT_DEBUG_1D
428-
429-
SUBROUTINE PRINT_DEBUG_2D(A2, NAME, HEADER)
430-
REAL(KIND=JPRB),INTENT(IN) :: A2(:,:)
431-
CHARACTER(LEN=*), INTENT(IN) :: NAME
432-
CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HEADER
433-
IF (PRESENT(HEADER)) WRITE(*,'(8X,A)') HEADER
434-
WRITE(*,'(A7,A3,I6,A3,I6, A3, I6, A2)') NAME, " | ", &
435-
& UBOUND(A2,1) - LBOUND(A2,1) + 1, " | " , &
436-
& UBOUND(A2,2) - LBOUND(A2,2) + 1, " |"
437-
END SUBROUTINE PRINT_DEBUG_2D
438-
439-
SUBROUTINE PRINT_DEBUG_3D(A3, NAME, HEADER)
440-
REAL(KIND=JPRB),INTENT(IN) :: A3(:,:,:)
441-
CHARACTER(LEN=*), INTENT(IN) :: NAME
442-
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HEADER
443-
IF (PRESENT(HEADER))WRITE(*,'(8X,A)') HEADER
444-
WRITE(*,'(A7,A3,I6,A3,I6, A3, I6, A2)') NAME, " | ", &
445-
& UBOUND(A3,1) - LBOUND(A3,1) + 1, " | " , &
446-
& UBOUND(A3,2) - LBOUND(A3,2) + 1, " | ", &
447-
& UBOUND(A3,3) - LBOUND(A3,3) + 1, " |"
448-
END SUBROUTINE PRINT_DEBUG_3D
449-
450-
SUBROUTINE PRINT_DEBUG_4D(A4, NAME, HEADER)
451-
REAL(KIND=JPRB),INTENT(IN) :: A4(:,:,:,:)
452-
CHARACTER(LEN=*), INTENT(IN) :: NAME
453-
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HEADER
454-
IF (PRESENT(HEADER))WRITE(*,'(8X,A)') HEADER
455-
WRITE(*,'(A7,A3,I6,A3,I6, A3, I6, A3, I6, A2)') NAME, " | ", &
456-
& UBOUND(A4,1) - LBOUND(A4,1) + 1, " | ", &
457-
& UBOUND(A4,2) - LBOUND(A4,2) + 1, " | ", &
458-
& UBOUND(A4,3) - LBOUND(A4,3) + 1, " | ", &
459-
& UBOUND(A4,4) - LBOUND(A4,4) + 1, " |"
460-
461-
END SUBROUTINE PRINT_DEBUG_4D
462-
463-
SUBROUTINE PRINT_DEBUG_HEADER(DESCRIPTION, NUMBER)
464-
CHARACTER(LEN=*), INTENT(IN) :: DESCRIPTION
465-
INTEGER, INTENT(IN), OPTIONAL :: NUMBER
466-
467-
WRITE(*,*) "-----------------------------------------------"
468-
IF (PRESENT(NUMBER)) THEN
469-
WRITE(*,*) "#", DESCRIPTION, NUMBER, "#"
470-
ELSE
471-
WRITE(*,*) "#", DESCRIPTION, "#"
472-
ENDIF
473-
WRITE(*,*) "-----------------------------------------------"
474-
475-
END SUBROUTINE PRINT_DEBUG_HEADER
476-
477-
SUBROUTINE PRINT_DEBUG_FOOTER()
478-
WRITE(*,*) "-----------------------------------------------"
479-
WRITE(*,*) ""
480-
END SUBROUTINE PRINT_DEBUG_FOOTER
481-
482-
SUBROUTINE PRINT_DEBUG_SEPARATOR()
483-
WRITE(*,*) "............."
484-
WRITE(*,*) ""
485-
END SUBROUTINE PRINT_DEBUG_SEPARATOR
486-
487-
SUBROUTINE PRINT_DEBUG_SUM(N)
488-
INTEGER, INTENT(IN) :: N
489-
WRITE(*,'(31X,A8)') "========"
490-
WRITE(*,'(33X,I4)') N
491-
492-
END SUBROUTINE PRINT_DEBUG_SUM
493308
END MODULE INV_TRANS_FIELD_API_MODULE

0 commit comments

Comments
 (0)