Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

Timestamp:

2011-03-30T17:58:35+02:00 (13 years ago)

Author:

rblod

Message:

First attempt to put dynamic allocation on the trunk

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90 (modified) (7 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

@@ -31 +31 @@
    USE dynadv          ! advection 
    USE solmat          ! matrix construction for elliptic solvers
-   USE solver          ! solver initialization
    USE solpcg          ! preconditionned conjugate gradient solver
    USE solsor          ! Successive Over-relaxation solver
@@ -63 +62 @@
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -105 +103 @@
       !! References : Roullet and Madec 1999, JGR.
       !!---------------------------------------------------------------------
-      USE oce, ONLY :   zub   => ta   ! ta used as workspace
-      USE oce, ONLY :   zvb   => sa   ! ta used as workspace
+      USE oce, ONLY:   zub   => ta , zvb   => sa   ! (ta,sa) used as workspace
       !!
       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
       INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge)
       !!                                   
-      INTEGER  ::   ji, jj, jk           ! dummy loop indices
-      REAL(wp) ::   z2dt, z2dtg          ! temporary scalars
-      REAL(wp) ::   zgcb, zbtd   !   -          -
-      REAL(wp) ::   ztdgu, ztdgv         !   -          -
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars
       !!----------------------------------------------------------------------
       !
@@ -123 +118 @@
        
          ! set to zero free surface specific arrays
-         spgu(:,:) = 0.e0                     ! surface pressure gradient (i-direction)
-         spgv(:,:) = 0.e0                     ! surface pressure gradient (j-direction)
-         CALL solver_init( nit000 )           ! Elliptic solver initialisation
+         spgu(:,:) = 0._wp                     ! surface pressure gradient (i-direction)
+         spgv(:,:) = 0._wp                     ! surface pressure gradient (j-direction)
 
          ! read filtered free surface arrays in restart file
@@ -205 +199 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            spgu(ji,jj) = 0.e0
-            spgv(ji,jj) = 0.e0
+            spgu(ji,jj) = 0._wp
+            spgv(ji,jj) = 0._wp
          END DO
       END DO
@@ -282 +276 @@
       ncut = 0
       ! if rnorme is 0, the solution is 0, the solver is not called
-      IF( rnorme == 0.e0 ) THEN
-         gcx(:,:) = 0.e0
-         res   = 0.e0
+      IF( rnorme == 0._wp ) THEN
+         gcx(:,:) = 0._wp
+         res   = 0._wp
          niter = 0
          ncut  = 999
@@ -356 +350 @@
 
    SUBROUTINE flt_rst( kt, cdrw )
-     !!---------------------------------------------------------------------
-     !!                   ***  ROUTINE ts_rst  ***
-     !!
-     !! ** Purpose : Read or write filtered free surface arrays in restart file
-     !!----------------------------------------------------------------------
-     INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-     CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
-     !!----------------------------------------------------------------------
-
-     IF( TRIM(cdrw) == 'READ' ) THEN
-        IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_rst  ***
+      !!
+      !! ** Purpose : Read or write filtered free surface arrays in restart file
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN
+         IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN
 ! Caution : extra-hallow
 ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
-           CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) )
-           CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) )
-           IF( neuler == 0 )   gcxb(:,:) = gcx (:,:)
-        ELSE
-           gcx (:,:) = 0.e0
-           gcxb(:,:) = 0.e0
-        ENDIF
-     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+            CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) )
+            CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) )
+            IF( neuler == 0 )   gcxb(:,:) = gcx (:,:)
+         ELSE
+            gcx (:,:) = 0.e0
+            gcxb(:,:) = 0.e0
+         ENDIF
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
 ! Caution : extra-hallow
 ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
-        CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) )
-        CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) )
-     ENDIF
-     !
+         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) )
+         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) )
+      ENDIF
+      !
    END SUBROUTINE flt_rst