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.
stpctl_tam.F90 in branches/TAM_V3_0/NEMOTAM/OPATAM_SRC – NEMO

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/stpctl_tam.F90 @ 1885

Last change on this file since 1885 was 1885, checked in by rblod, 14 years ago

add TAM sources
File size: 11.2 KB
Line 
1MODULE stpctl_tam
2#ifdef key_tam
3   !!==============================================================================
4   !!                       ***  MODULE  stpctl_tam  ***
5   !! Ocean run control :  gross check of the ocean time stepping
6   !!                      Tangent and adjoint module
7   !!==============================================================================
8
9   !!----------------------------------------------------------------------
10   !!   stp_ctl_tan      : Control the run
11   !!   stp_ctl_adj      : Control the run
12   !!----------------------------------------------------------------------
13   !! * Modules used
14   USE par_kind      , ONLY: & ! Precision variables
15      & wp
16   USE in_out_manager, ONLY: & ! I/O manager
17      & lwp,                 &
18      & numout,              & 
19      & numstp,              & 
20      & numsol,              &
21      & nwrite,              &
22      & cform_err,           &
23      & nit000
24   USE par_oce       , ONLY: & ! Ocean space and time domain variables
25      & jpi,                 &
26      & jpj,                 & 
27      & jpk
28   USE oce_tam       , ONLY: & ! ocean dynamics and tracers variables
29      & un_tl,               &
30      & vn_tl,               &
31      & tn_tl,               &
32      & sn_tl,               &
33      & un_ad,               &
34      & vn_ad,               &
35      & tn_ad,               &
36      & sn_ad
37   USE dom_oce       , ONLY: & ! Ocean space and time domain
38      & umask,               &
39      & vmask,               &
40      & tmask,               &
41      & nimpp,               &
42      & njmpp
43   USE sol_oce       , ONLY: & ! ocean space and time domain variables
44      & eps,                 &
45      & epsr,                &
46      & niter,               &
47      & res
48   USE solisl        , ONLY: & ! island solver
49      & lk_isl
50   USE lib_mpp       , ONLY: & ! distributed memory computing
51      & lk_mpp,              &
52      & mpp_max,             &
53      & mpp_maxloc
54   USE dynspg_oce    , ONLY: & ! pressure gradient schemes
55      & lk_dynspg_flt,       &
56      & lk_dynspg_rl
57   IMPLICIT NONE
58   PRIVATE
59
60   !! * Accessibility
61   PUBLIC stp_ctl_tan           ! routine called by steptan.F90
62   PUBLIC stp_ctl_adj           ! routine called by stepadj.F90
63   !!----------------------------------------------------------------------
64
65CONTAINS
66
67   SUBROUTINE stp_ctl_tan( kt, kindic, ksign )
68      !!----------------------------------------------------------------------
69      !!                    ***  ROUTINE stp_ctl_tan  ***
70      !!                     
71      !! ** Purpose of the direct routine:   Control the run
72      !!
73      !! ** Method  : - Save the time step in numstp
74      !!              - Print it each 50 time steps
75      !!              - Print solver statistics in numsol
76      !!              - Stop the run IF problem for the solver ( indec < 0 )
77      !!
78      !! History :
79      !!        !  91-03  ()
80      !!        !  91-11  (G. Madec)
81      !!        !  92-06  (M. Imbard)
82      !!        !  97-06  (A.M. Treguier)
83      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
84      !!----------------------------------------------------------------------
85      !! * Arguments
86      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
87      INTEGER, INTENT( in ) ::   ksign
88      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
89
90      !! * local declarations
91      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
92      INTEGER  ::   ii, ij, ik                 ! temporary integers
93      REAL(wp) ::   zumax, zvmax, ztmax, zsmax ! temporary scalars
94      INTEGER, DIMENSION(3) ::   ilocu         !
95      INTEGER, DIMENSION(3) ::   ilocv         !
96      INTEGER, DIMENSION(3) ::   iloct         !
97      INTEGER, DIMENSION(3) ::   ilocs         ! 
98      CHARACTER(len=80) :: clname
99      LOGICAL :: lfirst =.TRUE.
100      IF( kt == nit000 .AND. lwp .AND. lfirst ) THEN
101         WRITE(numout,*)
102         WRITE(numout,*) 'stp_ctl_tan : time-stepping control'
103         WRITE(numout,*) '~~~~~~~~~~~'
104         ! open time.step file
105         clname = 'time_tan.step'
106         CALL ctlopn( numstp, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
107         lfirst = .FALSE.
108      ENDIF
109
110      ! save the current time step in numstp
111      ! ------------------------------------
112      IF(lwp) WRITE(numstp,9100) kt
113      IF(lwp) REWIND(numstp)
1149100  FORMAT(1x, i8)
115
116
117      ! elliptic solver statistics (if required)
118      ! --------------------------
119      IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN
120      ! Solver
121      IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps
122
123      ! Islands (if exist)
124!!!!AV TO DO      IF( lk_isl )   CALL isl_stp_ctl_tan( kt, kindic )
125
126
127      ! Output in numwso and numwvo IF kindic<0
128      ! ---------------------------------------
129      !    (i.e. problem for the solver)
130      IF( kindic < 0 ) THEN
131         IF(lwp) THEN
132            WRITE(numout,*) ' stpctl_tan: the elliptic solver DO not converge or explode'
133            WRITE(numout,*) ' ========= '
134            WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
135            WRITE(numout,*)
136           WRITE(numout,*) ' =========  *******************************'
137         ENDIF
138      ENDIF
139      ENDIF
140
1419200  FORMAT(' it :', i8, ' niter :', i4, ' res :',e30.18,' b :',e30.18)
142
143      ! Test maximum of tangent fields
144      ! ------------------------
145
146      ! 1. zonal velocity
147      ! -----------------
148
149      !! zumax = MAXVAL( ABS( un_tl(:,:,:) ) )   ! slower than the following loop on NEC SX5
150      zumax = 0.e0
151      DO jk = 1, jpk
152         DO jj = 1, jpj
153            DO ji = 1, jpi
154               zumax = MAX(zumax,ABS(un_tl(ji,jj,jk)))
155          END DO
156        END DO
157      END DO       
158      IF( lk_mpp )   CALL mpp_max( zumax )   ! max over the global domain
159
160      IF( MOD( kt, nwrite ) == 1 ) THEN
161         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
162      ENDIF
163!      IF( zumax > 100.) THEN
164      IF( zumax > 500.) THEN
165         IF( lk_mpp ) THEN
166            CALL mpp_maxloc(ABS(un_tl),umask,zumax,ii,ij,ik)
167         ELSE
168            ilocu = MAXLOC( ABS( un_tl(:,:,:) ) )
169            ii = ilocu(1) + nimpp - 1
170            ij = ilocu(2) + njmpp - 1
171            ik = ilocu(3)
172         ENDIF
173         IF(lwp) THEN
174            WRITE(numout,cform_err)
175            WRITE(numout,*) ' stpctl_tan: the zonal velocity is larger than 20 m/s'
176            WRITE(numout,*) ' ========= '
177            WRITE(numout,9400) kt, zumax, ii, ij, ik
178            WRITE(numout,*)
179         ENDIF
180         kindic  = -3
181
182      ENDIF
1839400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i4)
184      ! 2. meridional velocity
185      ! ----------------------
186      zvmax = 0.e0
187      DO jk = 1, jpk
188         DO jj = 1, jpj
189            DO ji = 1, jpi
190               zvmax = MAX(zvmax,ABS(vn_tl(ji,jj,jk)))
191          END DO
192        END DO
193      END DO       
194      IF( lk_mpp )   CALL mpp_max( zvmax )   ! max over the global domain
195
196      IF( MOD( kt, nwrite ) == 1 ) THEN
197         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(V) max: ', zvmax
198      ENDIF
199!      IF( zvmax > 100.) THEN
200      IF( zvmax > 500.) THEN
201         IF( lk_mpp ) THEN
202            CALL mpp_maxloc(ABS(vn_tl),vmask,zvmax,ii,ij,ik)
203         ELSE
204            ilocv = MAXLOC( ABS( vn_tl(:,:,:) ) )
205            ii = ilocv(1) + nimpp - 1
206            ij = ilocv(2) + njmpp - 1
207            ik = ilocv(3)
208         ENDIF
209         IF(lwp) THEN
210            WRITE(numout,cform_err)
211            WRITE(numout,*) ' stpctl_tan: the meridional  velocity is larger than 10 m/s'
212            WRITE(numout,*) ' ========= '
213            WRITE(numout,9410) kt, zvmax, ii, ij, ik
214            WRITE(numout,*)
215         ENDIF
216         kindic  = -3
217      ENDIF
2189410  FORMAT (' kt=',i6,' max abs(V): ',1pg11.4,', i j k: ',3i4)
219      ! 3. Temperature
220      ! ----------------------
221      ztmax = 0.e0
222      DO jk = 1, jpk
223         DO jj = 1, jpj
224            DO ji = 1, jpi
225               ztmax = MAX(ztmax,ABS(tn_tl(ji,jj,jk)))
226          END DO
227        END DO
228      END DO       
229      IF( lk_mpp )   CALL mpp_max( ztmax )   ! max over the global domain
230
231      IF( MOD( kt, nwrite ) == 1 ) THEN
232         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(T) max: ', zTmax
233      ENDIF
234!      IF( ztmax > 300.) THEN
235      IF( ztmax > 600.) THEN
236         IF( lk_mpp ) THEN
237            CALL mpp_maxloc(ABS(tn_tl),tmask,ztmax,ii,ij,ik)
238         ELSE
239            iloct = MAXLOC( ABS( tn_tl(:,:,:) ) )
240            ii = iloct(1) + nimpp - 1
241            ij = iloct(2) + njmpp - 1
242            ik = iloct(3)
243         ENDIF
244         IF(lwp) THEN
245            WRITE(numout,cform_err)
246            WRITE(numout,*) ' stpctl_tan: the temperature is larger than 30 K'
247            WRITE(numout,*) ' ========= '
248            WRITE(numout,9420) kt, ztmax, ii, ij, ik
249            WRITE(numout,*)
250         ENDIF
251         kindic  = -3
252      ENDIF
2539420  FORMAT (' kt=',i6,' max abs(T): ',1pg11.4,', i j k: ',3i4)
254
255      ! 3. Temperature
256      ! ----------------------
257      zsmax = 0.e0
258      DO jk = 1, jpk
259         DO jj = 1, jpj
260            DO ji = 1, jpi
261               zsmax = MAX(zsmax,ABS(sn_tl(ji,jj,jk)))
262          END DO
263        END DO
264      END DO       
265      IF( lk_mpp )   CALL mpp_max( zsmax )   ! max over the global domain
266
267      IF( MOD( kt, nwrite ) == 1 ) THEN
268         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(S) max: ', zsmax
269      ENDIF
270!      IF( zsmax > 200.) THEN
271      IF( zsmax > 600.) THEN
272         IF( lk_mpp ) THEN
273            CALL mpp_maxloc(ABS(sn_tl),tmask,zsmax,ii,ij,ik)
274         ELSE
275            ilocs = MAXLOC( ABS( sn_tl(:,:,:) ) )
276            ii = ilocs(1) + nimpp - 1
277            ij = ilocs(2) + njmpp - 1
278            ik = ilocs(3)
279         ENDIF
280         IF(lwp) THEN
281            WRITE(numout,cform_err)
282            WRITE(numout,*) ' stpctl_tan: the Salinity is larger than 20 o/oo'
283            WRITE(numout,*) ' ========== '
284            WRITE(numout,9430) kt, zsmax, ii, ij, ik
285            WRITE(numout,*)
286         ENDIF
287         kindic  = -3
288      ENDIF
2899430  FORMAT (' kt=',i6,' max abs(S): ',1pg11.4,', i j k: ',3i4)
290
291   END SUBROUTINE stp_ctl_tan
292   SUBROUTINE stp_ctl_adj( kt, kindic, ksign )
293      !!----------------------------------------------------------------------
294      !!                    ***  ROUTINE stp_ctl_adj  ***
295      !!                     
296      !! ** Purpose of the direct routine:   Control the run
297      !!
298      !! ** Method  : - Save the time step in numstp
299      !!              - Print it each 50 time steps
300      !!              - Print solver statistics in numsol
301      !!              - Stop the run IF problem for the solver ( indec < 0 )
302      !!
303      !! History :
304      !!        !  91-03  ()
305      !!        !  91-11  (G. Madec)
306      !!        !  92-06  (M. Imbard)
307      !!        !  97-06  (A.M. Treguier)
308      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
309      !!----------------------------------------------------------------------
310      !! * Arguments
311      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
312      INTEGER, INTENT( in ) ::   ksign
313      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
314
315      !! * local declarations
316
317   END SUBROUTINE stp_ctl_adj
318
319   !!======================================================================
320#endif
321END MODULE stpctl_tam
Note: See TracBrowser for help on using the repository browser.