Ignore:
Timestamp:
2019-12-05T18:41:39+01:00 (11 months ago)
Author:
mathiot
Message:

include ENHANCE-02_ISF_nemo in UKMO merge branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/UKMO_MERGE_2019/tests/ISOMIP+/MY_SRC/istate.F90

    r11889 r12077  
    5050CONTAINS 
    5151 
    52    SUBROUTINE istate_init 
     52   SUBROUTINE istate_init( Kbb, Kmm, Kaa ) 
    5353      !!---------------------------------------------------------------------- 
    5454      !!                   ***  ROUTINE istate_init  *** 
     
    5656      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
    5757      !!---------------------------------------------------------------------- 
     58      INTEGER, INTENT( in )  ::  Kbb, Kmm, Kaa   ! ocean time level indices 
     59      ! 
    5860      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    5961!!gm see comment further down 
     
    7577      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    7678      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    77       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 
    7880      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    7981#if defined key_agrif 
    80       ua   (:,:,:  ) = 0._wp   ! used in agrif_oce_sponge at initialization 
    81       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     
    8284#endif 
    8385 
    8486      IF( ln_rstart ) THEN                    ! Restart from a file 
    8587         !                                    ! ------------------- 
    86          CALL rst_read                        ! Read the restart file 
     88         CALL rst_read( Kbb, Kmm )            ! Read the restart file 
    8789         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    8890         ! 
     
    9597         ! 
    9698         IF( ln_tsd_init ) THEN                
    97             CALL dta_tsd( nit000, 'ini', tsb )       ! read 3D T and S data at nit000 
     99            CALL dta_tsd( nit000, 'ini', ts(:,:,:,:,Kbb) )       ! read 3D T and S data at nit000 
    98100            ! 
    99             sshb(:,:)   = 0._wp               ! set the ocean at rest 
     101            ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
    100102            IF( ll_wd ) THEN 
    101                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  
    102104               ! 
    103105               ! Apply minimum wetdepth criterion 
     
    105107               DO jj = 1,jpj 
    106108                  DO ji = 1,jpi 
    107                      IF( ht_0(ji,jj) + sshb(ji,jj)  < rn_wdmin1 ) THEN 
    108                         sshb(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
     109                     IF( ht_0(ji,jj) + ssh(ji,jj,Kbb)  < rn_wdmin1 ) THEN 
     110                        ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 
    109111                     ENDIF 
    110112                  END DO 
    111113               END DO  
    112114            ENDIF  
    113             ub  (:,:,:) = 0._wp 
    114             vb  (:,:,:) = 0._wp   
     115            uu  (:,:,:,Kbb) = 0._wp 
     116            vv  (:,:,:,Kbb) = 0._wp   
    115117            ! 
    116118         ELSE                                 ! user defined initial T and S 
    117             CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )          
     119            CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
    118120         ENDIF 
    119          tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones 
    120          sshn (:,:)     = sshb(:,:)    
    121          un   (:,:,:)   = ub  (:,:,:) 
    122          vn   (:,:,:)   = vb  (:,:,:) 
    123          hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    124          CALL div_hor( 0 )                    ! compute interior hdivn value   
    125 !!gm                                    hdivn(:,:,:) = 0._wp 
     121         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)       ! set now values from to before ones 
     122         ssh (:,:,Kmm)     = ssh(:,:,Kbb)    
     123         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
     124         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
     125         hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
     126         CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value   
     127!!gm                                    hdiv(:,:,:) = 0._wp 
    126128 
    127129!!gm POTENTIAL BUG : 
    128 !!gm  ISSUE :  if sshb /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
     130!!gm  ISSUE :  if ssh(:,:,Kbb) /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
    129131!!             as well as gdept and gdepw....   !!!!!  
    130132!!      ===>>>>   probably a call to domvvl initialisation here.... 
     
    136138!            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
    137139!            CALL dta_uvd( nit000, zuvd ) 
    138 !            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    139 !            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
     140!            uu(:,:,:,Kbb) = zuvd(:,:,:,1) ;  uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 
     141!            vv(:,:,:,Kbb) = zuvd(:,:,:,2) ;  vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 
    140142!            DEALLOCATE( zuvd ) 
    141143!         ENDIF 
    142144         ! 
    143145!!gm This is to be changed !!!! 
    144 !         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
     146!         ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here 
    145147!         IF( .NOT.ln_linssh ) THEN 
    146148!            DO jk = 1, jpk 
    147 !               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     149!               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    148150!            END DO 
    149151!         ENDIF 
     
    155157      ! Do it whatever the free surface method, these arrays being eventually used 
    156158      ! 
    157       un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp 
    158       ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
     159      uu_b(:,:,Kmm) = 0._wp   ;   vv_b(:,:,Kmm) = 0._wp 
     160      uu_b(:,:,Kbb) = 0._wp   ;   vv_b(:,:,Kbb) = 0._wp 
    159161      ! 
    160 !!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked 
     162!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 
    161163      DO jk = 1, jpkm1 
    162164         DO jj = 1, jpj 
    163165            DO ji = 1, jpi 
    164                un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    165                vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     166               uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
     167               vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
    166168               ! 
    167                ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
    168                vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
     169               uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 
     170               vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 
    169171            END DO 
    170172         END DO 
    171173      END DO 
    172174      ! 
    173       un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 
    174       vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 
     175      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 
     176      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 
    175177      ! 
    176       ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    177       vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     178      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 
     179      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 
    178180      ! 
    179181   END SUBROUTINE istate_init 
Note: See TracChangeset for help on using the changeset viewer.