Changeset 7649 for branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

Timestamp:

2017-02-06T16:21:14+01:00 (7 years ago)

Author:

glong

Message:

dyn_vrt_dia subroutine added and calls added for most processes - spg, zdf, and bfr not yet done

File:

• branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90 (modified) (5 diffs)

branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

@@ -38 +38 @@
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
+   USE divcur         ! For dyn_vrt_dia
 
 
@@ -560 +561 @@
       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
       !!
+      INTEGER  :: id_dia_vrt_vor_int = 1                          ! TODO remove once flags set properly
+      INTEGER  :: id_dia_vrt_vor_mn  = 1                          ! TODO remove once flags set properly
       INTEGER  ::   ji, jj, jk                                    ! dummy loop indices
       INTEGER  ::   ierr                                          ! local integer
-      REAL(wp) ::   zfac12, zua, zva                              ! local scalars
+      REAL(wp) ::   zfac12                                        ! local scalars
       REAL(wp) ::   zmsk, ze3                                     ! local scalars
       !                                                           !  3D workspace 
       REAL(wp), POINTER    , DIMENSION(:,:  )         :: zwx, zwy, zwz
       REAL(wp), POINTER    , DIMENSION(:,:  )         :: ztnw, ztne, ztsw, ztse
+      REAL(wp), POINTER    , DIMENSION(:,:,:)         :: zua, zva
 #if defined key_vvl
       REAL(wp), POINTER    , DIMENSION(:,:,:)         :: ze3f     !  3D workspace (lk_vvl=T)
@@ -578 +582 @@
       CALL wrk_alloc( jpi, jpj,      zwx , zwy , zwz        ) 
       CALL wrk_alloc( jpi, jpj,      ztnw, ztne, ztsw, ztse ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zua, zva               ) 
 #if defined key_vvl
       CALL wrk_alloc( jpi, jpj, jpk, ze3f                   )
@@ -687 +692 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
-                  &                           + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
-               zva = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
-                  &                           + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
-               pua(ji,jj,jk) = pua(ji,jj,jk) + zua
-               pva(ji,jj,jk) = pva(ji,jj,jk) + zva
+               zua(ji,jj,jk) = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  )     &
+                  &                                     + ztnw(ji+1,jj) * zwy(ji+1,jj  )     &
+                  &                                     + ztse(ji,jj  ) * zwy(ji  ,jj-1)     &
+                  &                                     + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+               zva(ji,jj,jk) = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1)     &
+                  &                                     + ztse(ji,jj+1) * zwx(ji  ,jj+1)     &
+                  &                                     + ztnw(ji,jj  ) * zwx(ji-1,jj  )     &
+                  &                                     + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+               pua(ji,jj,jk) = pua(ji,jj,jk) + zua(ji,jj,jk)
+               pva(ji,jj,jk) = pva(ji,jj,jk) + zva(ji,jj,jk)
             END DO  
          END DO  
@@ -698 +707 @@
       END DO                                           !   End of slab
       !                                                ! ===============
+      IF ( ( id_dia_vrt_vor_int == 1 ) .or. ( id_dia_vrt_vor_mn == 1 ) ) THEN
+          CALL dyn_vrt_dia(zua, zva, id_dia_vrt_vor_int, id_dia_vrt_vor_mn)
+      END IF
+      !
       CALL wrk_dealloc( jpi, jpj,      zwx , zwy , zwz        ) 
       CALL wrk_dealloc( jpi, jpj,      ztnw, ztne, ztsw, ztse ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva               ) 
 #if defined key_vvl
       CALL wrk_dealloc( jpi, jpj, jpk, ze3f                   )