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.
agrif_opa_update.F90 in branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90 @ 4785

Last change on this file since 4785 was 4785, checked in by rblod, 10 years ago

dev_r4765_CNRS_agrif: First update of AGRIF for dynamic only (_flt and _ts), see ticket #1380 and associated wiki page
  • Property svn:keywords set to Id
File size: 19.6 KB
Line 
1#define TWO_WAY        /* TWO WAY NESTING */
2#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/
3 
4MODULE agrif_opa_update
5#if defined key_agrif  && ! defined key_offline
6   USE par_oce
7   USE oce
8   USE dom_oce
9   USE agrif_oce
10   USE in_out_manager  ! I/O manager
11   USE lib_mpp
12   USE wrk_nemo 
13   USE dynspg_oce
14
15   IMPLICIT NONE
16   PRIVATE
17
18   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales
19
20   !!----------------------------------------------------------------------
21   !! NEMO/NST 3.3 , NEMO Consortium (2010)
22   !! $Id$
23   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
24   !!----------------------------------------------------------------------
25
26CONTAINS
27
28   SUBROUTINE Agrif_Update_Tra( kt )
29      !!---------------------------------------------
30      !!   *** ROUTINE Agrif_Update_Tra ***
31      !!---------------------------------------------
32      INTEGER, INTENT(in) :: kt
33      !!---------------------------------------------
34      !
35      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
36#if defined TWO_WAY   
37      Agrif_UseSpecialValueInUpdate = .TRUE.
38      Agrif_SpecialValueFineGrid = 0.
39      !
40      IF (MOD(nbcline,nbclineupdate) == 0) THEN
41# if ! defined DECAL_FEEDBACK
42         CALL Agrif_Update_Variable(tsn_id, procname=updateTS)
43# else
44         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS)
45# endif
46      ELSE
47# if ! defined DECAL_FEEDBACK
48         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS)
49# else
50         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS)
51# endif
52      ENDIF
53      !
54      Agrif_UseSpecialValueInUpdate = .FALSE.
55#endif
56      !
57   END SUBROUTINE Agrif_Update_Tra
58
59   SUBROUTINE Agrif_Update_Dyn( kt )
60      !!---------------------------------------------
61      !!   *** ROUTINE Agrif_Update_Dyn ***
62      !!---------------------------------------------
63      INTEGER, INTENT(in) :: kt
64      !!---------------------------------------------
65      !
66      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return
67#if defined TWO_WAY
68      Agrif_UseSpecialValueInUpdate = .FALSE.
69      Agrif_SpecialValueFineGrid = 0.
70      !     
71      IF (mod(nbcline,nbclineupdate) == 0) THEN
72# if ! defined DECAL_FEEDBACK
73         CALL Agrif_Update_Variable(un_update_id,procname = updateU)
74         CALL Agrif_Update_Variable(vn_update_id,procname = updateV)
75# else
76         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU)
77         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV)
78# endif
79      ELSE
80# if ! defined DECAL_FEEDBACK
81         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU)
82         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)         
83# else
84         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU)
85         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV)
86# endif
87      ENDIF
88
89# if ! defined DECAL_FEEDBACK
90      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
91      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d) 
92# else
93      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d)
94      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d) 
95# endif
96
97# if defined key_dynspg_ts
98      IF (ln_bt_fw) THEN
99         ! Update time integrated transports
100         IF (mod(nbcline,nbclineupdate) == 0) THEN
101#  if ! defined DECAL_FEEDBACK
102            CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b)
103            CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b)
104#  else
105            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b)
106            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b)
107#  endif
108         ELSE
109#  if ! defined DECAL_FEEDBACK
110            CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b)
111            CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b)
112         ENDIF
113#  else
114         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b)
115         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b)
116#  endif
117      END IF 
118# endif
119      !
120      nbcline = nbcline + 1
121      !
122      Agrif_UseSpecialValueInUpdate = .TRUE.
123      Agrif_SpecialValueFineGrid = 0.
124# if ! defined DECAL_FEEDBACK
125      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH)
126# else
127      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH)
128# endif
129      Agrif_UseSpecialValueInUpdate = .FALSE.
130      !
131#endif
132   END SUBROUTINE Agrif_Update_Dyn
133
134
135   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
136      !!---------------------------------------------
137      !!           *** ROUTINE updateT ***
138      !!---------------------------------------------
139#  include "domzgr_substitute.h90"
140      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
141      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
142      LOGICAL, INTENT(in) :: before
143      !!
144      INTEGER :: ji,jj,jk,jn
145      !!---------------------------------------------
146      !
147      IF (before) THEN
148         DO jn = n1,n2
149            DO jk=k1,k2
150               DO jj=j1,j2
151                  DO ji=i1,i2
152                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)
153                  END DO
154               END DO
155            END DO
156         END DO
157      ELSE
158         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
159            ! Add asselin part
160            DO jn = n1,n2
161               DO jk=k1,k2
162                  DO jj=j1,j2
163                     DO ji=i1,i2
164                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
165                           tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 
166                              & + atfp * ( tabres(ji,jj,jk,jn) &
167                              &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
168                        ENDIF
169                     ENDDO
170                  ENDDO
171               ENDDO
172            ENDDO
173         ENDIF
174         DO jn = n1,n2
175            DO jk=k1,k2
176               DO jj=j1,j2
177                  DO ji=i1,i2
178                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
179                        tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
180                     END IF
181                  END DO
182               END DO
183            END DO
184         END DO
185      ENDIF
186      !
187   END SUBROUTINE updateTS
188
189   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before )
190      !!---------------------------------------------
191      !!           *** ROUTINE updateu ***
192      !!---------------------------------------------
193#  include "domzgr_substitute.h90"
194      !!
195      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
196      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
197      LOGICAL, INTENT(in) :: before
198      !!
199      INTEGER :: ji, jj, jk
200      REAL(wp) :: zrhoy
201      !!---------------------------------------------
202      !
203      IF (before) THEN
204         zrhoy = Agrif_Rhoy()
205         DO jk=k1,k2
206            DO jj=j1,j2
207               DO ji=i1,i2
208                  tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
209                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk)
210               END DO
211            END DO
212         END DO
213         tabres = zrhoy * tabres
214      ELSE
215         DO jk=k1,k2
216            DO jj=j1,j2
217               DO ji=i1,i2
218                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk)
219                  !
220                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
221                     ub(ji,jj,jk) = ub(ji,jj,jk) & 
222                       & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
223                  ENDIF
224                  !
225                  un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk)
226               END DO
227            END DO
228         END DO
229      ENDIF
230      !
231   END SUBROUTINE updateu
232
233   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before )
234      !!---------------------------------------------
235      !!           *** ROUTINE updatev ***
236      !!---------------------------------------------
237#  include "domzgr_substitute.h90"
238      !!
239      INTEGER :: i1,i2,j1,j2,k1,k2
240      INTEGER :: ji,jj,jk
241      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres
242      LOGICAL :: before
243      !!
244      REAL(wp) :: zrhox
245      !!---------------------------------------------     
246      !
247      IF (before) THEN
248         zrhox = Agrif_Rhox()
249         DO jk=k1,k2
250            DO jj=j1,j2
251               DO ji=i1,i2
252                  tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
253                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk)
254               END DO
255            END DO
256         END DO
257         tabres = zrhox * tabres
258      ELSE
259         DO jk=k1,k2
260            DO jj=j1,j2
261               DO ji=i1,i2
262                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk)
263                  !
264                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
265                     vb(ji,jj,jk) = vb(ji,jj,jk) & 
266                       & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
267                  ENDIF
268                  !
269                  vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk)
270               END DO
271            END DO
272         END DO
273      ENDIF
274      !
275   END SUBROUTINE updatev
276
277   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before )
278      !!---------------------------------------------
279      !!          *** ROUTINE updateu2d ***
280      !!---------------------------------------------
281#  include "domzgr_substitute.h90"
282      !!
283      INTEGER, INTENT(in) :: i1, i2, j1, j2
284      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
285      LOGICAL, INTENT(in) :: before
286      !!
287      INTEGER :: ji, jj, jk
288      REAL(wp) :: zrhoy
289      REAL(wp) :: zcorr
290      !!---------------------------------------------
291      !
292      IF (before) THEN
293         zrhoy = Agrif_Rhoy()
294         DO jj=j1,j2
295            DO ji=i1,i2
296               tabres(ji,jj) = un_b(ji,jj) * hu(ji,jj) * e2u(ji,jj)
297            END DO
298         END DO
299         tabres = zrhoy * tabres
300      ELSE
301         DO jj=j1,j2
302            DO ji=i1,i2
303               tabres(ji,jj) =  tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj) 
304               !   
305               ! Update "now" 3d velocities:
306               spgu(ji,jj) = 0.e0
307               DO jk=1,jpkm1
308                  spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk)
309               END DO
310               spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj)
311               !
312               zcorr = tabres(ji,jj) - spgu(ji,jj)
313               DO jk=1,jpkm1             
314                  un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk)           
315               END DO
316               !
317               ! Update barotropic velocities:
318#if defined key_dynspg_ts
319               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
320                  zcorr = tabres(ji,jj) - un_b(ji,jj)
321                  ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)
322               END IF
323#endif               
324               un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1)
325               !       
326               ! Correct "before" velocities to hold correct bt component:
327               spgu(ji,jj) = 0.e0
328               DO jk=1,jpkm1
329                  spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)
330               END DO
331               spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj)
332               !
333               zcorr = ub_b(ji,jj) - spgu(ji,jj)
334               DO jk=1,jpkm1             
335                  ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk)           
336               END DO
337               !
338            END DO
339         END DO
340      ENDIF
341      !
342   END SUBROUTINE updateu2d
343
344   SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before )
345      !!---------------------------------------------
346      !!          *** ROUTINE updatev2d ***
347      !!---------------------------------------------
348      INTEGER, INTENT(in) :: i1, i2, j1, j2
349      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
350      LOGICAL, INTENT(in) :: before
351      !!
352      INTEGER :: ji, jj, jk
353      REAL(wp) :: zrhox
354      REAL(wp) :: zcorr
355      !!---------------------------------------------
356      !
357      IF (before) THEN
358         zrhox = Agrif_Rhox()
359         DO jj=j1,j2
360            DO ji=i1,i2
361               tabres(ji,jj) = vn_b(ji,jj) * hv(ji,jj) * e1v(ji,jj) 
362            END DO
363         END DO
364         tabres = zrhox * tabres
365      ELSE
366         DO jj=j1,j2
367            DO ji=i1,i2
368               tabres(ji,jj) =  tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj) 
369               !   
370               ! Update "now" 3d velocities:
371               spgv(ji,jj) = 0.e0
372               DO jk=1,jpkm1
373                  spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk)
374               END DO
375               spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj)
376               !
377               zcorr = tabres(ji,jj) - spgv(ji,jj)
378               DO jk=1,jpkm1             
379                  vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk)           
380               END DO
381               !
382               ! Update barotropic velocities:
383#if defined key_dynspg_ts
384               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
385                  zcorr = tabres(ji,jj) - vn_b(ji,jj)
386                  vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)
387               END IF
388#endif               
389               vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1)
390               !       
391               ! Correct "before" velocities to hold correct bt component:
392               spgv(ji,jj) = 0.e0
393               DO jk=1,jpkm1
394                  spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)
395               END DO
396               spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj)
397               !
398               zcorr = vb_b(ji,jj) - spgv(ji,jj)
399               DO jk=1,jpkm1             
400                  vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk)           
401               END DO
402               !
403            END DO
404         END DO
405      ENDIF
406      !
407   END SUBROUTINE updatev2d
408     
409
410   SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before )
411      !!---------------------------------------------
412      !!          *** ROUTINE updateSSH ***
413      !!---------------------------------------------
414      INTEGER, INTENT(in) :: i1, i2, j1, j2
415      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
416      LOGICAL, INTENT(in) :: before
417      !!
418      INTEGER :: ji, jj
419      !!---------------------------------------------
420      !
421      IF (before) THEN
422         DO jj=j1,j2
423            DO ji=i1,i2
424               tabres(ji,jj) = sshn(ji,jj)
425            END DO
426         END DO
427      ELSE
428#if ! defined key_dynspg_ts
429         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
430            DO jj=j1,j2
431               DO ji=i1,i2
432                sshb(ji,jj) =   sshb(ji,jj) &
433                 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
434               END DO
435            END DO
436         ENDIF
437#endif
438         DO jj=j1,j2
439            DO ji=i1,i2
440               sshn(ji,jj) = tabres(ji,jj) * tmask(ji,jj,1)
441            END DO
442         END DO
443      ENDIF
444      !
445   END SUBROUTINE updateSSH
446
447   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before )
448      !!---------------------------------------------
449      !!          *** ROUTINE updateub2b ***
450      !!---------------------------------------------
451      INTEGER, INTENT(in) :: i1, i2, j1, j2
452      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
453      LOGICAL, INTENT(in) :: before
454      !!
455      INTEGER :: ji, jj
456      REAL(wp) :: zrhoy
457      !!---------------------------------------------
458      !
459      IF (before) THEN
460         zrhoy = Agrif_Rhoy()
461         DO jj=j1,j2
462            DO ji=i1,i2
463               tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj)
464            END DO
465         END DO
466         tabres = zrhoy * tabres
467      ELSE
468         DO jj=j1,j2
469            DO ji=i1,i2
470               ub2_b(ji,jj) = tabres(ji,jj) / e2u(ji,jj)
471            END DO
472         END DO
473      ENDIF
474      !
475   END SUBROUTINE updateub2b
476
477   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before )
478      !!---------------------------------------------
479      !!          *** ROUTINE updatevb2b ***
480      !!---------------------------------------------
481      INTEGER, INTENT(in) :: i1, i2, j1, j2
482      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
483      LOGICAL, INTENT(in) :: before
484      !!
485      INTEGER :: ji, jj
486      REAL(wp) :: zrhox
487      !!---------------------------------------------
488      !
489      IF (before) THEN
490         zrhox = Agrif_Rhox()
491         DO jj=j1,j2
492            DO ji=i1,i2
493               tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj) 
494            END DO
495         END DO
496         tabres = zrhox * tabres
497      ELSE
498         DO jj=j1,j2
499            DO ji=i1,i2
500               vb2_b(ji,jj) = tabres(ji,jj) / e1v(ji,jj)
501            END DO
502         END DO
503      ENDIF
504      !
505   END SUBROUTINE updatevb2b
506
507
508   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
509   ! currently not used
510      !!---------------------------------------------
511      !!           *** ROUTINE updateT ***
512      !!---------------------------------------------
513#  include "domzgr_substitute.h90"
514
515      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
516      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
517      LOGICAL, iNTENT(in) :: before
518
519      INTEGER :: ji,jj,jk
520      REAL(wp) :: ztemp
521
522      IF (before) THEN
523            DO jk=k1,k2
524               DO jj=j1,j2
525                  DO ji=i1,i2
526                     tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
527                     tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk)
528                     tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk)
529                  END DO
530               END DO
531            END DO
532            tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()
533            tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox()
534            tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy()
535      ELSE
536            DO jk=k1,k2
537               DO jj=j1,j2
538                  DO ji=i1,i2
539                     IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN
540                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
541                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk)
542                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk)
543                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))
544                     print *,'CORR = ',ztemp-1.
545                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, &
546                     tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp
547                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp
548                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp
549                     END IF
550                  END DO
551               END DO
552            END DO
553      ENDIF
554
555   END SUBROUTINE update_scales
556
557#else
558CONTAINS
559   SUBROUTINE agrif_opa_update_empty
560      !!---------------------------------------------
561      !!   *** ROUTINE agrif_opa_update_empty ***
562      !!---------------------------------------------
563      WRITE(*,*)  'agrif_opa_update : You should not have seen this print! error?'
564   END SUBROUTINE agrif_opa_update_empty
565#endif
566END MODULE agrif_opa_update
567
Note: See TracBrowser for help on using the repository browser.