Changeset 5034 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

Timestamp:

2015-01-15T14:48:42+01:00 (9 years ago)

Author:

andrewryan

Message:

merge with trunk

File:

• branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90 (modified) (18 diffs)

branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

@@ -34 +34 @@
    USE dtatsd          ! data temperature and salinity   (dta_tsd routine)
    USE dtauvd          ! data: U & V current             (dta_uvd routine)
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O library
    USE zpshde          ! partial step: hor. derivative (zps_hde routine)
    USE eosbn2          ! equation of state            (eos bn2 routine)
@@ -42 +40 @@
    USE dynspg_flt      ! filtered free surface
    USE sol_oce         ! ocean solver variables
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
    USE lib_mpp         ! MPP library
    USE restart         ! restart
@@ -56 +57 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
    !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -73 +74 @@
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('istate_init')
-      !
-
-      IF(lwp) WRITE(numout,*)
+      IF( nn_timing == 1 )   CALL timing_start('istate_init')
+      !
+
+      IF(lwp) WRITE(numout,*) ' '
       IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
@@ -83 +84 @@
       IF( lk_c1d ) CALL dta_uvd_init          ! Initialization of U & V input data
 
-      rhd  (:,:,:  ) = 0.e0
-      rhop (:,:,:  ) = 0.e0
-      rn2  (:,:,:  ) = 0.e0 
-      tsa  (:,:,:,:) = 0.e0    
+      rhd  (:,:,:  ) = 0._wp
+      rhop (:,:,:  ) = 0._wp
+      rn2  (:,:,:  ) = 0._wp
+      tsa  (:,:,:,:) = 0._wp   
+      rab_b(:,:,:,:) = 0._wp
+      rab_n(:,:,:,:) = 0._wp
 
       IF( ln_rstart ) THEN                    ! Restart from a file
@@ -110 +113 @@
          ELSEIF( cp_cfg == 'gyre' ) THEN         
             CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields
+        ELSEIF( cp_cfg == 'isomip' .OR. cp_cfg == 'isomip2') THEN
+            IF(lwp) WRITE(numout,*) 'Initialization of T+S for ISOMIP domain' 
+            tsn(:,:,:,jp_tem)=-1.9*tmask(:,:,:)          ! ISOMIP configuration : start from constant T+S fields 
+            tsn(:,:,:,jp_sal)=34.4*tmask(:,:,:)
+            tsb(:,:,:,:)=tsn(:,:,:,:)  
          ELSE                                    ! Initial T-S, U-V fields read in files
             IF ( ln_tsd_init ) THEN              ! read 3D T and S data at nit000
@@ -129 +137 @@
          CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )        ! before potential and in situ densities
 #if ! defined key_c1d
-         IF( ln_zps )   CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  & ! zps: before hor. gradient
-            &                                       rhd, gru , grv  )   ! of t,s,rd at ocean bottom
+         IF( ln_zps )    CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  &        ! Partial steps: before horizontal gradient
+            &                                      rhd, gru , grv, aru, arv, gzu, gzv, ge3ru, ge3rv,  &             !
+            &                                      gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi  )  ! of t, s, rd at the last ocean level
 #endif
          !   
@@ -162 +171 @@
       !
       DO jk = 1, jpkm1
-#if defined key_vectopt_loop
-         DO jj = 1, 1         !Vector opt. => forced unrolling
-            DO ji = 1, jpij
-#else 
          DO jj = 1, jpj
             DO ji = 1, jpi
-#endif                  
                un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
                vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
@@ -185 +189 @@
       !
       !
-      IF( nn_timing == 1 )  CALL timing_stop('istate_init')
+      IF( nn_timing == 1 )   CALL timing_stop('istate_init')
       !
    END SUBROUTINE istate_init
+
 
    SUBROUTINE istate_t_s
@@ -219 +224 @@
    END SUBROUTINE istate_t_s
 
+
    SUBROUTINE istate_eel
       !!----------------------------------------------------------------------
@@ -233 +239 @@
       USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
       USE iom
- 
+      !
       INTEGER  ::   inum              ! temporary logical unit
       INTEGER  ::   ji, jj, jk        ! dummy loop indices
@@ -244 +250 @@
       REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain
       !!----------------------------------------------------------------------
-
+      !
       SELECT CASE ( jp_cfg ) 
          !                                              ! ====================
@@ -375 +381 @@
       INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization
       !!----------------------------------------------------------------------
-
+      !
       SELECT CASE ( ntsinit)
-
+      !
       CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS '
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-
+         !
          DO jk = 1, jpk
             DO jj = 1, jpj
@@ -407 +413 @@
             END DO
          END DO
-
+         !
       CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files
          IF(lwp) WRITE(numout,*)
@@ -431 +437 @@
          tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 
          tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
-
+         !
       END SELECT
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -440 +446 @@
          WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_1d(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk )
       ENDIF
-
+      !
    END SUBROUTINE istate_gyre
+
 
    SUBROUTINE istate_uvg
@@ -457 +464 @@
       USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
       USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-
+      !
       INTEGER ::   ji, jj, jk        ! dummy loop indices
       INTEGER ::   indic             ! ???
@@ -567 +574 @@
    !!=====================================================================
 END MODULE istate
-