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.
trdmxl_trc_rst.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90

Last change on this file was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.
File size: 12.7 KB
Line 
1MODULE trdmxl_trc_rst
2   !!======================================================================
3   !!                       ***  MODULE  trdmxl_rst  ***
4   !! Ocean dynamic :  Input/Output files for restart on mixed-layer diagnostics
5   !!======================================================================
6   !! History :  9.0  ! 07-03 (C. Deltel) Original code
7   !!----------------------------------------------------------------------
8 
9#if defined key_top && defined key_trdmxl_trc
10   !!----------------------------------------------------------------------
11   USE in_out_manager  ! I/O manager
12   USE iom             ! I/O module
13   USE trc             ! for nn_dttrc ctrcnm
14   USE trdmxl_trc_oce  ! for lk_trdmxl_trc
15
16   USE yomhook, ONLY: lhook, dr_hook
17   USE parkind1, ONLY: jprb, jpim
18
19   IMPLICIT NONE
20   PRIVATE
21 
22   PUBLIC   trd_mxl_trc_rst_read    ! routine called by trd_mxl_init
23   PUBLIC   trd_mxl_trc_rst_write   ! routine called by step.F90
24 
25   INTEGER ::   nummldw_trc               ! logical unit for mld restart
26   !!---------------------------------------------------------------------------------
27   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
28   !! $Id$
29   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
30   !!---------------------------------------------------------------------------------
31 
32CONTAINS
33 
34
35    SUBROUTINE trd_mxl_trc_rst_write( kt )
36      !!--------------------------------------------------------------------------------
37      !!                  ***  SUBROUTINE trd_mxl_rst_wri  ***
38      !!               
39      !! ** Purpose :   Write mixed-layer diagnostics restart fields.
40      !!--------------------------------------------------------------------------------
41      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
42      !
43      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
44      CHARACTER(LEN=50)   ::   clname   ! output restart file name
45      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
46      CHARACTER (len=35) :: charout
47      INTEGER :: jl,  jk, jn               ! loop indice
48      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
49      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
50      REAL(KIND=jprb)               :: zhook_handle
51
52      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_MXL_TRC_RST_WRITE'
53
54      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
55
56      !!--------------------------------------------------------------------------------
57
58      IF( kt == nitrst - nn_dttrc .OR. nitend - nit000 + 1 < 2 * nn_dttrc ) THEN ! idem trcrst.F90
59         IF( nitrst > 1.0e9 ) THEN
60            WRITE(clkt,*) nitrst
61         ELSE
62           WRITE(clkt,'(i8.8)') nitrst
63         ENDIF
64         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out)
65         clpath = TRIM(cn_trcrst_outdir)
66         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
67         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  'TRIM(clpath)//TRIM(clname)
68         CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
69      ENDIF
70
71      IF( kt == nitend .AND. lk_trdmxl_trc ) THEN
72
73         IF( kt == nitend .AND. lwp ) THEN
74            WRITE(numout,*)
75            WRITE(numout,*) 'trdmxl_trc_rst: output for ML diags. restart, with trd_mxl_trc_rst_write routine'
76            WRITE(numout,*) '~~~~~~~~~~~~~~'
77            WRITE(numout,*)
78         ENDIF
79
80         IF( ln_trdmxl_trc_instant ) THEN 
81            !
82            DO jn = 1, jptra
83               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlbb_trc_'  //ctrcnm(jn), tmlbb_trc  (:,:,jn) )
84               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlbn_trc_'  //ctrcnm(jn), tmlbn_trc  (:,:,jn) )
85               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) )
86               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) )
87            END DO
88            !
89         ELSE
90            !
91            CALL iom_rstput( kt, nitrst, nummldw_trc, 'rmldbn_trc', rmldbn_trc )  ! 2D x 1
92           
93            !                                                          ! ===========
94            DO jn = 1, jptra                                           ! tracer loop
95               !                                                       ! ===========
96
97               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc (:,:,jn) ) ! 2D x jptra
98               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlbb_trc_'   //ctrcnm(jn), tmlbb_trc   (:,:,jn) ) ! 2D x jptra
99               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc (:,:,jn) ) ! 2D x jptra
100
101               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlbn_trc_'   //ctrcnm(jn), tmlbn_trc   (:,:,jn) ) ! 2D x jptra
102               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) ! 2D x jptra
103               
104               DO jk = 1, jpltrd_trc
105                  IF( jk < 10 )   THEN
106                     WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I1)") ctrcnm(jn), jk
107                  ELSE
108                     WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk
109                  ENDIF
110                  CALL iom_rstput( kt, nitrst, nummldw_trc, charout, tmltrd_csum_ub_trc(:,:,jk,jn) )
111               END DO
112               
113               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , &
114                    &           tmltrd_atf_sumb_trc(:,:,jn) ) ! 2D x jptra
115
116               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , &
117                    &           tmltrd_rad_sumb_trc(:,:,jn) ) ! 2D x jptra
118               !                                                       ! ===========
119            END DO                                                     ! tracer loop
120            !                                                          ! ===========
121#if defined key_pisces_reduced
122            DO jl = 1, jp_pisces_trd
123               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) )
124            ENDDO
125#endif
126
127         ENDIF
128         
129         CALL iom_close( nummldw_trc )
130         lrst_trc = .TRUE.
131
132      ENDIF
133
134      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
135    END SUBROUTINE trd_mxl_trc_rst_write
136
137
138    SUBROUTINE trd_mxl_trc_rst_read
139      !!----------------------------------------------------------------------------
140      !!                   ***  SUBROUTINE trd_mxl_rst_lec  ***
141      !!                   
142      !! ** Purpose :   Read file for mixed-layer diagnostics restart.
143      !!----------------------------------------------------------------------------
144      INTEGER  ::  inum       ! temporary logical unit
145      !
146      CHARACTER (len=35) :: charout
147      INTEGER ::  jk, jn, jl     ! loop indice
148      INTEGER ::  jlibalt = jprstlib
149      LOGICAL ::  llok
150      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
151      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
152      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
153      REAL(KIND=jprb)               :: zhook_handle
154
155      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_MXL_TRC_RST_READ'
156
157      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
158
159      !!-----------------------------------------------------------------------------
160     
161      IF(lwp)  THEN
162         WRITE(numout,*)
163         WRITE(numout,*) ' trd_mxl_trc_rst_read : read the NetCDF MLD restart file'
164         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~'
165      ENDIF
166     
167      clpath = TRIM(cn_trcrst_indir)
168      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
169
170      IF ( jprstlib == jprstdimg ) THEN
171        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
172        ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90
173        INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
174        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
175      ENDIF
176
177      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt ) 
178     
179      IF( ln_trdmxl_trc_instant ) THEN
180         
181         DO jn = 1, jptra
182            CALL iom_get( inum, jpdom_autoglo, 'tmlbb_trc_'  //ctrcnm(jn), tmlbb_trc  (:,:,jn) )
183            CALL iom_get( inum, jpdom_autoglo, 'tmlbn_trc_'  //ctrcnm(jn), tmlbn_trc  (:,:,jn) )
184            CALL iom_get( inum, jpdom_autoglo, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) )
185            CALL iom_get( inum, jpdom_autoglo, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) )
186         END DO
187         
188      ELSE
189         CALL iom_get( inum, jpdom_autoglo, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum
190         
191         !                                                          ! ===========
192         DO jn = 1, jptra                                           ! tracer loop
193            !                                                       ! ===========
194            CALL iom_get( inum, jpdom_autoglo, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) )
195            CALL iom_get( inum, jpdom_autoglo, 'tmlbb_trc_'   //ctrcnm(jn), tmlbb_trc  (:,:,jn) )
196            CALL iom_get( inum, jpdom_autoglo, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) )
197
198            CALL iom_get( inum, jpdom_autoglo, 'tmlbn_trc_'   //ctrcnm(jn), tmlbn_trc   (:,:,jn) ) ! needed for tml_sum
199            CALL iom_get( inum, jpdom_autoglo, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) )
200           
201            DO jk = 1, jpltrd_trc
202               IF( jk < 10 )   THEN
203                  WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I1)") ctrcnm(jn), jk
204               ELSE
205                  WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk
206               ENDIF
207               CALL iom_get( inum, jpdom_autoglo, charout, tmltrd_csum_ub_trc(:,:,jk,jn) )
208            END DO
209           
210            CALL iom_get( inum, jpdom_autoglo, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , &
211                 &        tmltrd_atf_sumb_trc(:,:,jn) )
212
213            CALL iom_get( inum, jpdom_autoglo, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , &
214                 &        tmltrd_rad_sumb_trc(:,:,jn) )
215            !                                                       ! ===========
216         END DO                                                     ! tracer loop
217         !                                                          ! ===========
218
219#if defined key_pisces_reduced
220         DO jl = 1, jp_pisces_trd
221            CALL iom_get( inum, jpdom_autoglo, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) )
222         ENDDO
223#endif
224         
225         CALL iom_close( inum )
226      ENDIF
227     
228      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
229    END SUBROUTINE trd_mxl_trc_rst_read
230 
231#else
232  !!=================================================================================
233  !!                       ***  MODULE  trdmxl_rst  ***
234  !! Ocean dynamic :  Input/Output files for restart on mixed-layer diagnostics
235  !!=================================================================================
236CONTAINS
237  SUBROUTINE trd_mxl_trc_rst_opn( kt )
238  INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
239  INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
240  REAL(KIND=jprb)               :: zhook_handle
241
242  CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_MXL_TRC_RST_OPN'
243
244  IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
245
246    WRITE(*,*) 'trd_mxl_trc_rst_opn: You should not have seen this print! error?', kt
247  IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
248  END SUBROUTINE trd_mxl_trc_rst_opn
249  SUBROUTINE trd_mxl_trc_rst_write( kt )           !  No ML diags ==> empty routine
250  INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
251  INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
252  REAL(KIND=jprb)               :: zhook_handle
253
254  CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_MXL_TRC_RST_WRITE'
255
256  IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
257
258    WRITE(*,*) 'trd_mxl_trc_rst_wri: You should not have seen this print! error?', kt
259  IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
260  END SUBROUTINE trd_mxl_trc_rst_write
261  SUBROUTINE trd_mxl_trc_rst_read                  !  No ML Diags ==> empty routine
262  INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
263  INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
264  REAL(KIND=jprb)               :: zhook_handle
265
266  CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_MXL_TRC_RST_READ'
267
268  IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
269
270  IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
271  END SUBROUTINE trd_mxl_trc_rst_read
272#endif
273
274  !!=================================================================================
275END MODULE trdmxl_trc_rst
Note: See TracBrowser for help on using the repository browser.