Changeset 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

Timestamp:

2017-12-13T15:58:53+01:00 (6 years ago)

Author:

timgraham

Message:

Merge of dev_CNRS_2017 into branch

File:

• branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90 (modified) (6 diffs)

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

@@ -26 +26 @@
    USE in_out_manager ! I/O manager
    USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
 
@@ -67 +66 @@
       REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z
       REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt
-      REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp       ! acceptance criteria for neutrality (N2==0)
-      REAL(wp), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point...
-      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point...
-      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvab   ! vertical profile of alpha and beta
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zn2    ! N^2 
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zab    ! alpha and beta
-      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace
+      REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp      ! acceptance criteria for neutrality (N2==0)
+      REAL(wp), DIMENSION(        jpk     ) ::   zvn2         ! vertical profile of N2 at 1 given point...
+      REAL(wp), DIMENSION(        jpk,jpts) ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ) ::   zn2          ! N^2 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   zab          ! alpha and beta
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
       !
       LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is
@@ -80 +78 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('tra_npc')
+      IF( ln_timing )   CALL timing_start('tra_npc')
       !
       IF( MOD( kt, nn_npc ) == 0 ) THEN
          !
-         CALL wrk_alloc( jpi, jpj, jpk, zn2 )    ! N2
-         CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta
-         CALL wrk_alloc( jpk, 2, zvts, zvab )    ! 1D column vector at point ji,jj
-         CALL wrk_alloc( jpk, zvn2 )             ! 1D column vector at point ji,jj
-
          IF( l_trdtra )   THEN                    !* Save initial after fields
-            CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+            ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
             ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
             ztrds(:,:,:) = tsa(:,:,:,jp_sal)
          ENDIF
-
+         !
          IF( l_LB_debug ) THEN
             ! Location of 1 known convection site to follow what's happening in the water column
@@ -101 +94 @@
             klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...          
          ENDIF
-         
+         !
          CALL eos_rab( tsa, zab )         ! after alpha and beta (given on T-points)
          CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala  (given on W-points)
-        
+         !
          inpcc = 0
-
+         !
          DO jj = 2, jpjm1                 ! interior column only
             DO ji = fs_2, fs_jpim1
@@ -313 +306 @@
             CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt )
             CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds )
-            CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+            DEALLOCATE( ztrdt, ztrds )
          ENDIF
          !
@@ -323 +316 @@
          ENDIF
          !
-         CALL wrk_dealloc(jpi, jpj, jpk, zn2 )
-         CALL wrk_dealloc(jpi, jpj, jpk, 2, zab )
-         CALL wrk_dealloc(jpk, zvn2 )
-         CALL wrk_dealloc(jpk, 2, zvts, zvab )
-         !
       ENDIF   ! IF( MOD( kt, nn_npc ) == 0 ) THEN
       !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_npc')
+      IF( ln_timing )   CALL timing_stop('tra_npc')
       !
    END SUBROUTINE tra_npc