Changeset 9125 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

Timestamp:

2017-12-19T09:47:17+01:00 (6 years ago)

Author:

timgraham

Message:

Removed wrk_arrays from whole code. No change in SETTE results from this.

File:

• branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 (modified) (10 diffs)

branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

@@ -22 +22 @@
    USE fldread        ! type FLD_N
    USE timing         ! preformance summary
-   USE wrk_nemo       ! working arrays
 
    IMPLICIT NONE
@@ -76 +75 @@
       REAL(wp) ::   zaw, zbw, zrw
       !
-      REAL(wp), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace 
-      REAL(wp), POINTER, DIMENSION(:,:)     :: zpe                         ! 2D workspace 
-      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zpe                         ! 2D workspace 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace
+
       !!--------------------------------------------------------------------
       IF( ln_timing )   CALL timing_start('dia_ar5')
@@ -85 +85 @@
       IF( kt == nit000 )     CALL dia_ar5_init
 
-      IF( l_ar5 ) THEN
-         CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres )
-         CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    )
-         CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 )
+      IF( l_ar5 ) THEN 
+         ALLOCATE( zarea_ssh(jpi,jpj) , zbotpres(jpi,jpj) )
+         ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) )
+         ALLOCATE( ztsn(jpi,jpj,jpk,jpts) )
          zarea_ssh(:,:) = area(:,:) * sshn(:,:)
       ENDIF
@@ -212 +212 @@
       ! Exclude points where rn2 is negative as convection kicks in here and
       ! work is not being done against stratification
-         CALL wrk_alloc( jpi, jpj, zpe )
+         ALLOCATE( zpe(jpi,jpj) )
          zpe(:,:) = 0._wp
          IF( ln_zdfddm ) THEN
@@ -247 +247 @@
 !!gm           CALL lbc_lnk( zpe, 'T', 1._wp)         
           CALL iom_put( 'tnpeo', zpe )
-          CALL wrk_dealloc( jpi, jpj, zpe )
-      ENDIF
-      !
+          DEALLOCATE( zpe )
+      ENDIF
+
       IF( l_ar5 ) THEN
-        CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres )
-        CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    )
-        CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 )
+        DEALLOCATE( zarea_ssh , zbotpres )
+        DEALLOCATE( zrhd      , zrhop    )
+        DEALLOCATE( ztsn                 )
       ENDIF
       !
@@ -274 +274 @@
       !
       INTEGER    ::  ji, jj, jk
-      REAL(wp), POINTER, DIMENSION(:,:)  :: z2d
+      REAL(wp), DIMENSION(jpi,jpj)  :: z2d
 
     
-
-      CALL wrk_alloc( jpi, jpj, z2d )
       z2d(:,:) = pua(:,:,1) 
       DO jk = 1, jpkm1
@@ -315 +313 @@
        ENDIF
           
-       CALL wrk_dealloc( jpi, jpj, z2d )
-
    END SUBROUTINE dia_ar5_hst
 
@@ -330 +326 @@
       INTEGER  ::   ji, jj, jk  ! dummy loop indices
       REAL(wp) ::   zztmp  
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
       !
       !!----------------------------------------------------------------------
@@ -341 +337 @@
       IF( l_ar5 ) THEN
          !
-         CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )
          !                                      ! allocate dia_ar5 arrays
          IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' )
@@ -357 +352 @@
          IF( lk_mpp )   CALL mpp_sum( vol0 )
 
-         CALL iom_open ( 'sali_ref_clim_monthly', inum )
-         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  )
-         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 )
-         CALL iom_close( inum )
-
-         sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )        
-         sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)
-         IF( ln_zps ) THEN               ! z-coord. partial steps
-            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
-               DO ji = 1, jpi
-                  ik = mbkt(ji,jj)
-                  IF( ik > 1 ) THEN
-                     zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
-                     sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
-                  ENDIF
-               END DO
-            END DO
+         IF( iom_use( 'sshthster' ) ) THEN
+            ALLOCATE( zsaldta(jpi,jpj,jpj,jpts) )
+            CALL iom_open ( 'sali_ref_clim_monthly', inum )
+            CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  )
+            CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 )
+            CALL iom_close( inum )
+
+            sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )        
+            sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)
+            IF( ln_zps ) THEN               ! z-coord. partial steps
+               DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
+                  DO ji = 1, jpi
+                     ik = mbkt(ji,jj)
+                     IF( ik > 1 ) THEN
+                        zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                        sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+            !
+            DEALLOCATE( zsaldta )
          ENDIF
-         !
-         CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )
          !
       ENDIF