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.
prtctl_trc.F90 in NEMO/trunk/src/TOP – NEMO

source: NEMO/trunk/src/TOP/prtctl_trc.F90 @ 11954

Last change on this file since 11954 was 10570, checked in by acc, 5 years ago

Trunk update to implement finer control over the choice of text report files generated. See ticket: #2167
  • Property svn:keywords set to Id
File size: 13.4 KB
RevLine 
[331]1MODULE prtctl_trc
[945]2   !!======================================================================
3   !!                         ***  MODULE prtctl_trc  ***
4   !! TOP :   print all SUM trends for each processor domain
5   !!======================================================================
6   !! History :    -   !  2005-07  (C. Talandier) original code for OPA
7   !!             1.0  !  2005-10  (C. Ethe     ) adapted to passive tracer
8   !!----------------------------------------------------------------------
9   !!   prt_ctl_trc      :   control print in mpp for passive tracers
10   !!   prt_ctl_trc_info :   ???
11   !!   prt_ctl_trc_init :   ???
12   !!----------------------------------------------------------------------
13   USE par_trc          ! TOP parameters
[331]14   USE oce_trc          ! ocean space and time domain variables
[3680]15   USE prtctl           ! print control for OPA
[331]16
17   IMPLICIT NONE
18   PRIVATE
19
[945]20   INTEGER , DIMENSION(:), ALLOCATABLE ::   numid_trc          !: logical unit
21   INTEGER , DIMENSION(:), ALLOCATABLE ::   nlditl , nldjtl    !: first, last indoor index for each i-domain
22   INTEGER , DIMENSION(:), ALLOCATABLE ::   nleitl , nlejtl    !: first, last indoor index for each j-domain
23   INTEGER , DIMENSION(:), ALLOCATABLE ::   nimpptl, njmpptl   !: i-, j-indexes for each processor
24   INTEGER , DIMENSION(:), ALLOCATABLE ::   nlcitl , nlcjtl    !: dimensions of every subdomain
25   INTEGER , DIMENSION(:), ALLOCATABLE ::   ibonitl, ibonjtl
[331]26
[945]27   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   tra_ctl         !: previous trend values
[331]28
29   PUBLIC prt_ctl_trc         ! called by all subroutines
30   PUBLIC prt_ctl_trc_info    !
31   PUBLIC prt_ctl_trc_init    ! called by opa.F90
[945]32
[331]33CONTAINS
34
[945]35   SUBROUTINE prt_ctl_trc( tab4d, mask, clinfo, ovlap, kdim, clinfo2 )
[331]36      !!----------------------------------------------------------------------
37      !!                     ***  ROUTINE prt_ctl  ***
38      !!
39      !! ** Purpose : - print sum control 3D arrays over the same area
40      !!                in mono and mpp case. This way can be usefull when
41      !!                debugging a new parametrization in mono or mpp.
42      !!
43      !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to
44      !!                .true. in the ocean namelist:
45      !!              - to debug a MPI run .vs. a mono-processor one;
46      !!                the control print will be done over each sub-domain.
47      !!                The nictl[se] and njctl[se] parameters in the namelist must
48      !!                be set to zero and [ij]splt to the corresponding splitted
49      !!                domain in MPI along respectively i-, j- directions.
50      !!              - to debug a mono-processor run over the whole domain/a specific area;
51      !!                in the first case the nictl[se] and njctl[se] parameters must be set
52      !!                to zero else to the indices of the area to be controled. In both cases
53      !!                isplt and jsplt must be set to 1.
54      !!              - All arguments of the above calling sequence are optional so their
55      !!                name must be explicitly typed if used. For instance if the mask
56      !!                array tmask(:,:,:) must be passed through the prt_ctl subroutine,
[945]57      !!                it must looks like: CALL prt_ctl( mask=tmask ).
58      !!----------------------------------------------------------------------
59      REAL(wp)         , DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d     ! 4D array
60      REAL(wp)         , DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask      ! 3D mask to apply to the tab4d array
61      CHARACTER (len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array
62      CHARACTER (len=*)                    , INTENT(in), OPTIONAL ::   clinfo2   ! ???
63      INTEGER                              , INTENT(in), OPTIONAL ::   ovlap     ! overlap value
64      INTEGER                              , INTENT(in), OPTIONAL ::   kdim      ! k- direction for 4D arrays
[331]65      !!
[945]66      INTEGER  ::   overlap, jn, js, sind, eind, kdir, j_id
67      REAL(wp) ::   zsum, zvctl
[7646]68      CHARACTER (len=20), ALLOCATABLE, DIMENSION(:) ::   cl
[945]69      CHARACTER (len=10) ::   cl2
[9125]70      REAL(wp), DIMENSION(jpi,jpj,jpk)  :: zmask, ztab3d 
[331]71      !!----------------------------------------------------------------------
72
[7646]73      ALLOCATE( cl(jptra) )
[945]74      !                                      ! Arrays, scalars initialization
[331]75      overlap       = 0
76      kdir          = jpkm1
77      zsum          = 0.e0
78      zvctl         = 0.e0
79      cl(:)         = ''
80      cl2           = ''
81      ztab3d(:,:,:) = 0.e0
82      zmask (:,:,:) = 1.e0
83
[945]84      !                                      ! Control of optional arguments
85      IF( PRESENT(ovlap)   )   overlap       = ovlap
86      IF( PRESENT(kdim)    )   kdir          = kdim
87      IF( PRESENT(clinfo ) )   cl(:)         = clinfo(:)
88      IF( PRESENT(clinfo2) )   cl2           = clinfo2
89      IF( PRESENT(mask)    )   zmask (:,:,:) = mask(:,:,:)
[331]90
[945]91      IF( lk_mpp )   THEN      ! processor number
[331]92         sind = narea
93         eind = narea
[945]94      ELSE                     ! processors total number
[331]95         sind = 1
96         eind = ijsplt
97      ENDIF
98
99      ! Loop over each sub-domain, i.e. the total number of processors ijsplt
100      DO js = sind, eind
[945]101         !
[625]102         ! Set logical unit
[945]103         j_id = numid_trc( js - narea + 1 )
[331]104         ! Set indices for the SUM control
105         IF( .NOT. lsp_area ) THEN
106            IF (lk_mpp )   THEN
107               nictls = MAX( 1, nlditl(js) - overlap )
108               nictle = nleitl(js) + overlap * MIN( 1, nlcitl(js) - nleitl(js)) 
109               njctls = MAX( 1, nldjtl(js) - overlap )
110               njctle = nlejtl(js) + overlap * MIN( 1, nlcjtl(js) - nlejtl(js))
111               ! Do not take into account the bound of the domain
[945]112               IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 )   nictls = MAX( 2, nictls )
113               IF( ibonitl(js) ==  1 .OR. ibonitl(js) == 2 )   nictle = MIN( nictle, nleitl(js) - 1 )
114               IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 )   njctls = MAX( 2, njctls )
115               IF( ibonjtl(js) ==  1 .OR. ibonjtl(js) == 2 )   njctle = MIN( njctle, nlejtl(js) - 1 )
[331]116            ELSE
117               nictls = MAX( 1, nimpptl(js) + nlditl(js) - 1 - overlap )
118               nictle = nimpptl(js) + nleitl(js) - 1 + overlap * MIN( 1, nlcitl(js) - nleitl(js) ) 
119               njctls = MAX( 1, njmpptl(js) + nldjtl(js) - 1 - overlap )
120               njctle = njmpptl(js) + nlejtl(js) - 1 + overlap * MIN( 1, nlcjtl(js) - nlejtl(js) ) 
121               ! Do not take into account the bound of the domain
[945]122               IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 )   nictls = MAX( 2, nictls )
123               IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 )   njctls = MAX( 2, njctls )
124               IF( ibonitl(js) ==  1 .OR. ibonitl(js) == 2 )   nictle = MIN( nictle, nimpptl(js) + nleitl(js) - 2 )
125               IF( ibonjtl(js) ==  1 .OR. ibonjtl(js) == 2 )   njctle = MIN( njctle, njmpptl(js) + nlejtl(js) - 2 )
[331]126            ENDIF
127         ENDIF
[945]128         !
[331]129         IF( PRESENT(clinfo2) ) THEN
130            DO jn = 1, jptra
131               zvctl  = tra_ctl(jn,js)
132               ztab3d(:,:,:) = tab4d(:,:,:,jn)
[945]133               zsum          = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir)   &
134                  &                * zmask(nictls:nictle,njctls:njctle,1:kdir) )
[627]135               WRITE(j_id,FMT="(3x,a,' : ',D23.16)") cl(jn), zsum-zvctl
[331]136               tra_ctl(jn,js) = zsum
[945]137            END DO
[331]138         ELSE
139            DO jn = 1, jptra
140               ztab3d(:,:,:) = tab4d(:,:,:,jn)
[945]141               zsum          = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir)   &
142                  &               *  zmask(nictls:nictle,njctls:njctle,1:kdir) )
[627]143               WRITE(j_id,FMT="(3x,a,' : ',D23.16)") cl(jn), zsum
[331]144            END DO
145         ENDIF
[945]146         !
147      END DO
148      !
[7646]149      DEALLOCATE( cl )
[2715]150      !
[945]151   END SUBROUTINE prt_ctl_trc
[331]152
153
[945]154   SUBROUTINE prt_ctl_trc_info( clinfo )
[331]155      !!----------------------------------------------------------------------
156      !!                     ***  ROUTINE prt_ctl_trc_info  ***
157      !!
158      !! ** Purpose : - print information without any computation
159      !!----------------------------------------------------------------------
[945]160      CHARACTER (len=*), INTENT(in) ::   clinfo      ! information to print
161      !!
162      INTEGER ::   js, sind, eind, j_id
[331]163      !!----------------------------------------------------------------------
164
[945]165      IF( lk_mpp ) THEN      ! processor number
[331]166         sind = narea
167         eind = narea
[945]168      ELSE                   ! total number of processors
[331]169         sind = 1
170         eind = ijsplt
171      ENDIF
172
173      ! Loop over each sub-domain, i.e. number of processors ijsplt
174      DO js = sind, eind
[627]175         j_id = numid_trc(js - narea + 1)
[945]176         WRITE(j_id,*) clinfo
177      END DO
178      !
179   END SUBROUTINE prt_ctl_trc_info
[331]180
181
182   SUBROUTINE prt_ctl_trc_init
183      !!----------------------------------------------------------------------
184      !!                     ***  ROUTINE prt_ctl_trc_init  ***
185      !!
186      !! ** Purpose :   open ASCII files & compute indices
187      !!----------------------------------------------------------------------
[945]188      INTEGER            ::   js, sind, eind, j_id
[331]189      CHARACTER (len=31) :: clfile_out
190      CHARACTER (len=27) :: clb_name
191      CHARACTER (len=19) :: cl_run
192      !!----------------------------------------------------------------------
193
[945]194      !                             ! Allocate arrays
195      ALLOCATE( nlditl (ijsplt) )
196      ALLOCATE( nldjtl (ijsplt) )
197      ALLOCATE( nleitl (ijsplt) )
198      ALLOCATE( nlejtl (ijsplt) )
199      ALLOCATE( nimpptl(ijsplt) )
200      ALLOCATE( njmpptl(ijsplt) )
201      ALLOCATE( nlcitl (ijsplt) )
202      ALLOCATE( nlcjtl (ijsplt) )
203      ALLOCATE( tra_ctl(jptra,ijsplt) )
204      ALLOCATE( ibonitl(ijsplt) )
205      ALLOCATE( ibonjtl(ijsplt) )
[331]206
[945]207      tra_ctl(:,:) = 0.e0           ! Initialization to zero
[331]208
209      IF( lk_mpp ) THEN
210         sind = narea
211         eind = narea
[10570]212         clb_name = "('mpp.top.output_',I4.4)"
[331]213         cl_run = 'MULTI processor run'
214         ! use indices for each area computed by mpp_init subroutine
[4520]215         nlditl(1:jpnij) = nldit(:) 
216         nleitl(1:jpnij) = nleit(:) 
217         nldjtl(1:jpnij) = nldjt(:) 
218         nlejtl(1:jpnij) = nlejt(:) 
[331]219         !
[4520]220         nimpptl(1:jpnij) = nimppt(:)
221         njmpptl(1:jpnij) = njmppt(:)
[331]222         !
[4520]223         nlcitl(1:jpnij) = nlcit(:)
224         nlcjtl(1:jpnij) = nlcjt(:)
[331]225         !
[4520]226         ibonitl(1:jpnij) = ibonit(:)
227         ibonjtl(1:jpnij) = ibonjt(:)
[331]228      ELSE
229         sind = 1
230         eind = ijsplt
[10570]231         clb_name = "('mono.top.output_',I4.4)"
[945]232         cl_run   = 'MONO processor run '
[331]233         ! compute indices for each area as done in mpp_init subroutine
234         CALL sub_dom
235      ENDIF
236
[945]237      ALLOCATE( numid_trc(eind-sind+1) )
[625]238
[331]239      DO js = sind, eind
240         WRITE(clfile_out,FMT=clb_name) js-1
[1581]241         CALL ctl_opn( numid_trc(js -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
[627]242         j_id = numid_trc(js -narea + 1)
243         WRITE(j_id,*)
244         WRITE(j_id,*) '                 L O D Y C - I P S L'
[945]245         WRITE(j_id,*) '                       N E M 0 '
[627]246         WRITE(j_id,*) '            Ocean General Circulation Model'
[945]247         WRITE(j_id,*) '               version TOP 1.0  (2005) '
[627]248         WRITE(j_id,*)
249         WRITE(j_id,*) '                   PROC number: ', js
250         WRITE(j_id,*)
[945]251         WRITE(j_id,FMT="(19x,a20)") cl_run
[331]252
253         ! Print the SUM control indices
254         IF( .NOT. lsp_area )   THEN
255            IF ( lk_mpp )   THEN
256               nictls = nlditl(js) 
257               nictle = nleitl(js)
258               njctls = nldjtl(js)
259               njctle = nlejtl(js)
260            ELSE
261               nictls = nimpptl(js) + nlditl(js) - 1
262               nictle = nimpptl(js) + nleitl(js) - 1
263               njctls = njmpptl(js) + nldjtl(js) - 1
264               njctle = njmpptl(js) + nlejtl(js) - 1
265            ENDIF
266         ENDIF
[627]267         WRITE(j_id,*) 
268         WRITE(j_id,*) 'prt_tra_ctl :  Sum control indices'
269         WRITE(j_id,*) '~~~~~~~'
270         WRITE(j_id,*)
271         WRITE(j_id,9000)'                                nlej   = ', nlejtl(js), '              '
272         WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------'
273         WRITE(j_id,9001)'                  |                                       |'
274         WRITE(j_id,9001)'                  |                                       |'
275         WRITE(j_id,9001)'                  |                                       |'
276         WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle
277         WRITE(j_id,9002)'           nldi   = ', nlditl(js),  '                           nlei   = ', nleitl(js)
278         WRITE(j_id,9001)'                  |                                       |'
279         WRITE(j_id,9001)'                  |                                       |'
280         WRITE(j_id,9001)'                  |                                       |'
281         WRITE(j_id,9004)'  njmpp  = ',njmpptl(js),'   ------------- njctls = ', njctls, ' -------------'
282         WRITE(j_id,9003)'           nimpp  = ', nimpptl(js), '        nldj   = ', nldjtl(js), '              '
283         WRITE(j_id,*)
284         WRITE(j_id,*)
[331]285
2869000     FORMAT(a41,i4.4,a14)
2879001     FORMAT(a59)
2889002     FORMAT(a20,i4.4,a36,i3.3)
2899003     FORMAT(a20,i4.4,a17,i4.4)
2909004     FORMAT(a11,i4.4,a26,i4.4,a14)
[945]291      END DO
292      !
[331]293   END SUBROUTINE prt_ctl_trc_init
294
295END MODULE prtctl_trc
Note: See TracBrowser for help on using the repository browser.