Changeset 5601 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90

Timestamp:

2015-07-16T11:04:29+02:00 (9 years ago)

Author:

cbricaud

Message:

commit changes/bugfix/... for crs ; ok with time-splitting/fixed volume

File:

• branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90 (modified) (12 diffs)

branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_crs.F90

@@ -19 +19 @@
    !!                  the isopycnal or geopotential s-coord. operator 
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
-   USE trc_oce         ! share passive tracers/Ocean variables
-   USE zdf_oce         ! ocean vertical physics
-   USE ldftra_oce      ! ocean active tracers: lateral physics
- !  USE ldfslp          ! iso-neutral slopes
+!   USE oce             ! ocean dynamics and active tracers
+!   USE dom_oce         ! ocean space and time domain
+!   USE trc_oce         ! share passive tracers/Ocean variables
+!   USE zdf_oce         ! ocean vertical physics
+!   USE ldftra_oce      ! ocean active tracers: lateral physics
+!   USE ldfslp          ! iso-neutral slopes
    USE ldfslp_crs          ! iso-neutral slopes
    USE diaptr          ! poleward transport diagnostics
@@ -35 +35 @@
    USE wrk_nemo        ! Memory Allocation
    USE timing          ! Timing
-   USE crs
+!   USE crs
+   USE oce_trc
+   USE iom, ONLY : iom_put,iom_swap
 
    IMPLICIT NONE
@@ -94 +96 @@
       !! ** Action :   Update pta arrays with the before rotated diffusion
       !!----------------------------------------------------------------------
-      USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace
       !
       INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
@@ -113 +114 @@
 #endif
       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zdkt, zdk1t, z2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, ztfw 
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, ztfw , zftu,  zftv 
       !!----------------------------------------------------------------------
       !
@@ -119 +120 @@
       !
       CALL wrk_alloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw , zftu, zftv ) 
       !
 
@@ -149 +150 @@
             END DO
          END DO
-    !    WRITE(numout,*) ' test1 ', zdit
-!cc commenté pour le test concluant de TMP16 --> pgu mauvais, correction dans
-!zpshde_crs ( probleme de signe lorsque ze3wu negatif, de mem pour pgv)
          IF( ln_zps ) THEN      ! partial steps correction at the last ocean level 
             DO jj = 1, jpjm1
@@ -160 +158 @@
             END DO
          ENDIF
-!cc
-     !   WRITE(numout,*) ' test2 ', zdit
 
          !!----------------------------------------------------------------------
@@ -183 +179 @@
             DO jj = 1 , jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-   !               zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj)
-  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj)
- !               zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj)
-zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj)
+                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2e3u_msk(ji,jj,jk) / e1u_crs(ji,jj)
+                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1e3v_msk(ji,jj,jk) / e2v_crs(ji,jj)
 
                   zmsku = 1. / MAX(  tmask_crs(ji+1,jj,jk  ) + tmask_crs(ji,jj,jk+1)   &
@@ -194 +188 @@
                      &             + tmask_crs(ji,jj+1,jk+1) + tmask_crs(ji,jj,jk  ), 1. )
                   !
-    !              zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk)) vue avec Gurvan OK
-                zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk))
-  !                zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk))  vue avec Gurvan OK
-                zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk))
-           !        zcof1 = - fsahtu(ji,jj,jk) * e2u_crs(ji,jj) * uslp(ji,jj,jk) * zmsku
-           !        zcof2 = - fsahtv(ji,jj,jk) * e1v_crs(ji,jj) * vslp(ji,jj,jk) * zmskv  
+                  zcof1 = - fsahtu(ji,jj,jk) * e2e3u_msk(ji,jj,jk) * uslp_crs(ji,jj,jk) * zmsku / MAX( 1._wp , e3u_max_crs(ji,jj,jk))
+                  zcof2 = - fsahtv(ji,jj,jk) * e1e3v_msk(ji,jj,jk) * vslp_crs(ji,jj,jk) * zmskv / MAX( 1._wp , e3v_max_crs(ji,jj,jk))
                   !
                   zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk)   &
@@ -209 +199 @@
                END DO
             END DO
+            CALL iom_swap( "nemo_crs"  )
+            CALL iom_put( "zftu" , zftu )
+            CALL iom_put( "zftv" , zftv )
+            CALL iom_swap( "nemo" )
 
             ! II.4 Second derivative (divergence) and add to the general trend
@@ -285 +279 @@
                   zcoef3 = zcoef0 * e1e2w_crs(ji,jj,jk) * zmsku * wslpi_crs(ji,jj,jk) / e1t_crs(ji,jj)
                   zcoef4 = zcoef0 * e1e2w_crs(ji,jj,jk) * zmskv * wslpj_crs(ji,jj,jk) / e2t_crs(ji,jj)
-           !       zcoef3 = zcoef0 * e2t_crs(ji,jj) * zmsku * wslpi (ji,jj,jk)
-           !       zcoef4 = zcoef0 * e1t_crs(ji,jj) * zmskv * wslpj (ji,jj,jk)
                   ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
                      &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
@@ -312 +304 @@
       !
       CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
-      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw , zftu, zftv ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')