New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12377 for NEMO/trunk/src/OCE/DOM/istate.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/trunk/src/OCE/DOM/istate.F90

    r10499 r12377  
    2828   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
    2929   USE domvvl          ! varying vertical mesh 
    30    USE iscplrst        ! ice sheet coupling 
    3130   USE wet_dry         ! wetting and drying (needed for wad_istate) 
    3231   USE usrdef_istate   ! User defined initial state 
     
    4342 
    4443   !! * Substitutions 
    45 #  include "vectopt_loop_substitute.h90" 
     44#  include "do_loop_substitute.h90" 
    4645   !!---------------------------------------------------------------------- 
    4746   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5150CONTAINS 
    5251 
    53    SUBROUTINE istate_init 
     52   SUBROUTINE istate_init( Kbb, Kmm, Kaa ) 
    5453      !!---------------------------------------------------------------------- 
    5554      !!                   ***  ROUTINE istate_init  *** 
     
    5756      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
    5857      !!---------------------------------------------------------------------- 
     58      INTEGER, INTENT( in )  ::  Kbb, Kmm, Kaa   ! ocean time level indices 
     59      ! 
    5960      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    6061!!gm see comment further down 
     
    7677      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    7778      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    78       tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk 
     79      ts  (:,:,:,:,Kaa) = 0._wp                                   ! set one for all to 0 at level jpk 
    7980      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    8081#if defined key_agrif 
    81       ua   (:,:,:  ) = 0._wp   ! used in agrif_oce_sponge at initialization 
    82       va   (:,:,:  ) = 0._wp   ! used in agrif_oce_sponge at initialization     
     82      uu   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization 
     83      vv   (:,:,:  ,Kaa) = 0._wp   ! used in agrif_oce_sponge at initialization     
    8384#endif 
    8485 
    8586      IF( ln_rstart ) THEN                    ! Restart from a file 
    8687         !                                    ! ------------------- 
    87          CALL rst_read                        ! Read the restart file 
    88          IF (ln_iscpl)       CALL iscpl_stp   ! extrapolate restart to wet and dry 
     88         CALL rst_read( Kbb, Kmm )            ! Read the restart file 
    8989         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    9090         ! 
     
    9797         ! 
    9898         IF( ln_tsd_init ) THEN                
    99             CALL dta_tsd( nit000, tsb )       ! read 3D T and S data at nit000 
     99            CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
    100100            ! 
    101             sshb(:,:)   = 0._wp               ! set the ocean at rest 
     101            ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
    102102            IF( ll_wd ) THEN 
    103                sshb(:,:) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
     103               ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
    104104               ! 
    105105               ! Apply minimum wetdepth criterion 
    106106               ! 
    107                DO jj = 1,jpj 
    108                   DO ji = 1,jpi 
    109                      IF( ht_0(ji,jj) + sshb(ji,jj)  < rn_wdmin1 ) THEN 
    110                         sshb(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    111                      ENDIF 
    112                   END DO 
    113                END DO  
     107               DO_2D_11_11 
     108                  IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
     109                     ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
     110                  ENDIF 
     111               END_2D 
    114112            ENDIF  
    115             ub  (:,:,:) = 0._wp 
    116             vb  (:,:,:) = 0._wp   
     113            uu  (:,:,:,Kbb) = 0._wp 
     114            vv  (:,:,:,Kbb) = 0._wp   
    117115            ! 
    118116         ELSE                                 ! user defined initial T and S 
    119             CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )          
     117            CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
    120118         ENDIF 
    121          tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones 
    122          sshn (:,:)     = sshb(:,:)    
    123          un   (:,:,:)   = ub  (:,:,:) 
    124          vn   (:,:,:)   = vb  (:,:,:) 
    125          hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    126          CALL div_hor( 0 )                    ! compute interior hdivn value   
    127 !!gm                                    hdivn(:,:,:) = 0._wp 
     119         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
     120         ssh (:,:,Kmm)     = ssh(:,:,Kbb)    
     121         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
     122         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
     123         hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
     124         CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value   
     125!!gm                                    hdiv(:,:,:) = 0._wp 
    128126 
    129127!!gm POTENTIAL BUG : 
    130 !!gm  ISSUE :  if sshb /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
     128!!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
    131129!!             as well as gdept and gdepw....   !!!!!  
    132130!!      ===>>>>   probably a call to domvvl initialisation here.... 
     
    138136!            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
    139137!            CALL dta_uvd( nit000, zuvd ) 
    140 !            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    141 !            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
     138!            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 
     139!            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 
    142140!            DEALLOCATE( zuvd ) 
    143141!         ENDIF 
    144142         ! 
    145143!!gm This is to be changed !!!! 
    146 !         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
     144!         ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 
    147145!         IF( .NOT.ln_linssh ) THEN 
    148146!            DO jk = 1, jpk 
    149 !               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     147!               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    150148!            END DO 
    151149!         ENDIF 
     
    157155      ! Do it whatever the free surface method, these arrays being eventually used 
    158156      ! 
    159       un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp 
    160       ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
     157      uu_b(:,:,Kmm) = 0._wp   ;   vv_b(:,:,Kmm) = 0._wp 
     158      uu_b(:,:,Kbb) = 0._wp   ;   vv_b(:,:,Kbb) = 0._wp 
    161159      ! 
    162 !!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked 
    163       DO jk = 1, jpkm1 
    164          DO jj = 1, jpj 
    165             DO ji = 1, jpi 
    166                un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    167                vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    168                ! 
    169                ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
    170                vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
    171             END DO 
    172          END DO 
    173       END DO 
     160!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 
     161      DO_3D_11_11( 1, jpkm1 ) 
     162         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
     163         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
     164         ! 
     165         uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 
     166         vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 
     167      END_3D 
    174168      ! 
    175       un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 
    176       vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 
     169      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 
     170      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 
    177171      ! 
    178       ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    179       vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     172      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 
     173      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 
    180174      ! 
    181175   END SUBROUTINE istate_init 
Note: See TracChangeset for help on using the changeset viewer.