Changeset 3671

Timestamp:

2012-11-27T13:49:55+01:00 (11 years ago)

Author:

epico

Message:

Reorganize the MUSCL upstream switching scheme

Location:

branches/2012/dev_LOCEAN_UKMO_CMCC_INGV_2012/NEMOGCM/NEMO/OPA_SRC/TRA

Files:

• traadv.F90 (modified) (3 diffs)
• traadv_muscl.F90 (modified) (7 diffs)

branches/2012/dev_LOCEAN_UKMO_CMCC_INGV_2012/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

@@ -45 +45 @@
    LOGICAL ::   ln_traadv_qck    = .FALSE.   ! QUICKEST scheme flag
 
+
    INTEGER ::   nadv   ! choice of the type of advection scheme
 
@@ -152 +153 @@
       NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     &
          &                 ln_traadv_muscl, ln_traadv_muscl2,  &
-         &                 ln_traadv_ubs  , ln_traadv_qck
+         &                 ln_traadv_ubs  , ln_traadv_qck,     &
+         &                 ln_traadv_msc_ups
       !!----------------------------------------------------------------------
 
@@ -169 +171 @@
          WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs
          WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck    = ', ln_traadv_qck
+         WRITE(numout,*) '      upstream scheme within muscl   ln_traadv_msc_ups= ', ln_traadv_msc_ups
       ENDIF
 

branches/2012/dev_LOCEAN_UKMO_CMCC_INGV_2012/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

@@ -8 +8 @@
    !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
    !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            3.4  !  2012-06  (P. Oddo) include the upstream where needed
+   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
    !!----------------------------------------------------------------------
 
@@ -18 +18 @@
    USE dom_oce         ! ocean space and time domain
    USE trdmod_oce      ! tracers trends 
-   USE trdtra      ! tracers trends 
+   USE trdtra          ! tracers trends 
    USE eosbn2          ! equation of state 
    USE in_out_manager  ! I/O manager
@@ -38 +38 @@
    PUBLIC   tra_adv_muscl  ! routine called by step.F90
 
-   LOGICAL  :: l_trd       ! flag to compute trends
+   LOGICAL  :: l_trd                        ! flag to compute trends
+   LOGICAL, PUBLIC  :: ln_traadv_msc_ups= .FALSE.   ! use upstream scheme within muscl
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits
    !                                                             !  and in closed seas (orca 2 and 4 configurations)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zind         !: mixed upstream/centered index
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -86 +88 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy
       INTEGER  ::   ierr
-      REAL(wp) ::   zice                             ! temporary scalars
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztfreez
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zind
       !!----------------------------------------------------------------------
       !
@@ -94 +93 @@
       !
       CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy )
-      CALL wrk_alloc( jpi, jpj, ztfreez )
-      CALL wrk_alloc( jpi, jpj, jpk, zind )
       !
 
@@ -101 +98 @@
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '        : xed up-stream            ' , ln_traadv_msc_ups
          IF(lwp) WRITE(numout,*) '~~~~~~~'
          IF(lwp) WRITE(numout,*)
          !
          !
-         IF (.not. ALLOCATED(upsmsk))THEN
-             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
-             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate array')
+         IF(ln_traadv_msc_ups) THEN
+           IF (.not. ALLOCATED(upsmsk))THEN
+               ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
+               IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate upsmsk array')
+           ENDIF
+           upsmsk(:,:) = 0._wp                             ! not upstream by default
          ENDIF
-         !
-         upsmsk(:,:) = 0._wp                             ! not upstream by default
+
+         IF (.not. ALLOCATED(zind))THEN
+             ALLOCATE( zind(jpi,jpj,jpk), STAT=ierr )
+             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate zind array')
+         ENDIF
+         !
          !
          l_trd = .FALSE.
          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
-      ENDIF
 
       !
       ! Upstream / centered scheme indicator
       ! ------------------------------------
-      ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) )
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !                                        ! below ice covered area (if tn < "freezing"+0.1 )
-               IF( tsn(ji,jj,jk,jp_tem) <= ztfreez(ji,jj) + 0.1_wp ) THEN   ;   zice = 1.e0
-               ELSE                                                         ;   zice = 0.e0
-               ENDIF
-               zind(ji,jj,jk) = MAX (   &
-                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
-                  upsmsk(ji,jj)               ,      &  ! some of some straits
-                  zice                               &  ! below ice covered area (if tn < "freezing"+0.1 )
-                  &                  ) * tmask(ji,jj,jk)
-               zind(ji,jj,jk) = 1 - zind(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+         zind(:,:,:) = 1._wp                             ! set equal to 0 where up-stream is needed
+
+         IF(ln_traadv_msc_ups) THEN
+           DO jk = 1, jpk
+              DO jj = 1, jpj
+                 DO ji = 1, jpi
+                    zind(ji,jj,jk) = 1  - MAX (           &
+                       rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
+                       upsmsk(ji,jj) ) * tmask(ji,jj,jk)     ! some of some straits
+                 END DO
+              END DO
+           END DO
+         ENDIF 
+      !
+      ENDIF ! end kit000
       !                                                     ! ===========
       DO jn = 1, kjpt                                       ! tracer loop
@@ -297 +299 @@
       !
       CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy )
-      CALL wrk_dealloc( jpi, jpj, ztfreez )
-      CALL wrk_dealloc( jpi, jpj, jpk, zind )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl')