New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
isfutils.F90 in NEMO/branches/2020/r12377_ticket2386/src/OCE/ISF – NEMO

source: NEMO/branches/2020/r12377_ticket2386/src/OCE/ISF/isfutils.F90 @ 13540

Last change on this file since 13540 was 13540, checked in by andmirek, 3 years ago

Ticket #2386: update to latest trunk

File size: 6.4 KB
Line 
1MODULE isfutils
2   !!======================================================================
3   !!                       ***  MODULE  isfutils  ***
4   !! istutils module : miscelenious useful routines
5   !!======================================================================
6   !! History :  4.1  !  2019-09  (P. Mathiot) original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   isfutils       : - read_2dcstdta to read a constant input file with iom_get
11   !!                    - debug to print array sum, min, max in ocean.output
12   !!----------------------------------------------------------------------
13
14   USE iom           , ONLY: iom_open, iom_get, iom_close, jpdom_global      ! read input file
15   USE lib_fortran   , ONLY: glob_sum, glob_min, glob_max                    ! compute global value
16   USE par_oce       , ONLY: jpi,jpj,jpk, jpnij, Nis0, Nie0, Njs0, Nje0      ! domain size
17   USE dom_oce       , ONLY: narea, tmask_h, tmask_i                         ! local domain
18   USE in_out_manager, ONLY: i8, wp, lwp, numout                             ! miscelenious
19   USE lib_mpp
20
21   IMPLICIT NONE
22
23   PRIVATE
24
25   INTERFACE debug
26      MODULE PROCEDURE debug2d, debug3d
27   END INTERFACE debug
28
29   PUBLIC read_2dcstdta, debug
30
31CONTAINS
32
33   SUBROUTINE read_2dcstdta(cdfile, cdvar, pvar)
34      !!--------------------------------------------------------------------
35      !!                  ***  ROUTINE read_2dcstdta  ***
36      !!
37      !! ** Purpose : read input file
38      !!
39      !!-------------------------- OUT -------------------------------------
40      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pvar     ! output variable
41      !!-------------------------- IN  -------------------------------------
42      CHARACTER(len=*)            , INTENT(in   ) :: cdfile   ! input file name
43      CHARACTER(len=*)            , INTENT(in   ) :: cdvar    ! variable name
44      !!--------------------------------------------------------------------
45      INTEGER :: inum
46      !!--------------------------------------------------------------------
47
48      CALL iom_open( TRIM(cdfile), inum )
49      CALL iom_get( inum, jpdom_global, TRIM(cdvar), pvar)
50      CALL iom_close(inum)
51
52   END SUBROUTINE read_2dcstdta
53
54   SUBROUTINE debug2d(cdtxt,pvar)
55      !!--------------------------------------------------------------------
56      !!                  ***  ROUTINE isf_debug2d  ***
57      !!
58      !! ** Purpose : add debug print for 2d variables
59      !!
60      !!-------------------------- IN  -------------------------------------
61      CHARACTER(LEN=*)            , INTENT(in   ) :: cdtxt
62      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pvar
63      !!--------------------------------------------------------------------
64      REAL(wp)    :: zmin, zmax, zsum
65      INTEGER(i8) :: imodd, ip
66      INTEGER     :: imods
67      INTEGER     :: isums, idums
68      INTEGER     :: ji,jj,jk
69      INTEGER, DIMENSION(jpnij) :: itmps
70      !!--------------------------------------------------------------------
71      !
72      ! global min/max/sum to check data range and NaN
73      zsum = glob_sum( 'debug', pvar(:,:) )
74      zmin = glob_min( 'debug', pvar(:,:) )
75      zmax = glob_max( 'debug', pvar(:,:) )
76      !
77      ! basic check sum to check reproducibility
78      ! TRANSFER function find out the integer corresponding to pvar(i,j) bit pattern
79      ! MOD allow us to keep only the latest digits during the sum
80      ! imod is not choosen to be very large as at the end there is a classic mpp_sum
81      imodd=65521 ! highest prime number < 2**16 with i8 type
82      imods=65521 ! highest prime number < 2**16 with default integer for mpp_sum subroutine
83      isums=0 ; itmps(:)=0 ;
84      !
85      ! local MOD sum
86      DO jj=Njs0,Nje0
87         DO ji=Nis0,Nie0
88            idums = ABS(MOD(TRANSFER(pvar(ji,jj), ip),imodd))
89            itmps(narea) = MOD(itmps(narea) + idums, imods)
90         END DO
91      END DO
92      !
93      ! global MOD sum
94      CALL mpp_max('debug',itmps(:))
95      DO jk = 1,jpnij
96         isums = MOD(isums + itmps(jk),imods)
97      END DO
98      !
99      ! print out
100      IF (lwp) THEN
101         WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, isums
102         CALL FLUSH(numout)
103      END IF
104      !
105   END SUBROUTINE debug2d
106
107   SUBROUTINE debug3d(cdtxt,pvar)
108      !!--------------------------------------------------------------------
109      !!                  ***  ROUTINE isf_debug3d  ***
110      !!
111      !! ** Purpose : add debug print for 3d variables
112      !!
113      !!-------------------------- IN  -------------------------------------
114      CHARACTER(LEN=*)                , INTENT(in   ) :: cdtxt
115      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvar
116      !!--------------------------------------------------------------------
117      REAL(wp)    :: zmin, zmax, zsum
118      INTEGER(i8) :: imodd, ip
119      INTEGER     :: imods
120      INTEGER     :: isums, idums
121      INTEGER     :: ji,jj,jk
122      INTEGER, DIMENSION(jpnij) :: itmps
123      !!--------------------------------------------------------------------
124      !
125      ! global min/max/sum to check data range and NaN
126      zsum = glob_sum( 'debug', pvar(:,:,:) )
127      zmin = glob_min( 'debug', pvar(:,:,:) )
128      zmax = glob_max( 'debug', pvar(:,:,:) )
129      !
130      ! basic check sum to check reproducibility
131      ! TRANSFER function find out the integer corresponding to pvar(i,j) bit pattern
132      ! MOD allow us to keep only the latest digits during the sum
133      ! imod is not choosen to be very large as at the end there is a classic mpp_sum
134      imodd=65521 ! highest prime number < 2**16 with i8 type
135      imods=65521 ! highest prime number < 2**16 with default integer for mpp_sum subroutine
136      itmps=0; isums=0
137      !
138      ! local MOD sum
139      DO jk=1,jpk
140         DO jj=Njs0,Nje0
141            DO ji=Nis0,Nie0
142               idums = ABS(MOD(TRANSFER(pvar(ji,jj,jk), ip),imodd))
143               itmps(narea) = MOD(itmps(narea) + idums, imods)
144            END DO
145         END DO
146      END DO
147      !
148      ! global MOD sum
149      CALL mpp_max('debug',itmps)
150      DO jk = 1,jpnij
151         isums = MOD(isums+itmps(jk),imods)
152      END DO
153      !
154      ! print out
155      IF (lwp) THEN
156         WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, isums
157         CALL FLUSH(numout)
158      END IF
159      !
160   END SUBROUTINE debug3d
161
162END MODULE isfutils
Note: See TracBrowser for help on using the repository browser.