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 2690 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90 – NEMO

Ignore:
Timestamp:
2011-03-15T16:27:46+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2636 r2690  
    2929   USE obc_oce 
    3030   USE bdy_oce 
    31    USE diaar5, ONLY :   lk_diaar5 
     31   USE diaar5, ONLY:   lk_diaar5 
    3232   USE iom 
    33    USE sbcrnf, ONLY  : h_rnf, nk_rnf  ! River runoff  
     33   USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff  
    3434#if defined key_agrif 
    3535   USE agrif_opa_update 
     
    5252   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5353   !! $Id$ 
    54    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    55    !!---------------------------------------------------------------------- 
    56  
     54   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     55   !!---------------------------------------------------------------------- 
    5756CONTAINS 
    5857 
     
    7675      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    7776      !!---------------------------------------------------------------------- 
    78       USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace 
    79       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, z2d => wrk_2d_2 
    81       !! 
     77      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     78      USE oce     , ONLY:   z3d   => ta                           ! ta used as 3D workspace 
     79      USE wrk_nemo, ONLY:   zhdiv => wrk_2d_1 , z2d => wrk_2d_2   ! 2D workspace 
     80      ! 
    8281      INTEGER, INTENT(in) ::   kt   ! time step 
    83       !! 
    84       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    85       REAL(wp) ::   zcoefu, zcoefv, zcoeff      ! temporary scalars 
    86       REAL(wp) ::   z2dt, z1_2dt, z1_rau0       ! temporary scalars 
     82      ! 
     83      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     84      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars 
    8785      !!---------------------------------------------------------------------- 
    8886 
     
    9795         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    9896         ! 
    99          wn(:,:,jpk) = 0.e0                   ! bottom boundary condition: w=0 (set once for all) 
     97         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
    10098         ! 
    10199         IF( lk_vvl ) THEN                    ! before and now Sea SSH at u-, v-, f-points (vvl case only) 
     
    150148         hv(:,:) = hv_0(:,:) + sshv_n(:,:) 
    151149         !                                            ! now masked inverse of the ocean depth (at u- and v-points) 
    152          hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1.e0 - umask(:,:,1) ) 
    153          hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) 
     150         hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) ) 
     151         hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) ) 
    154152         !  
    155153      ENDIF 
     
    157155      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity 
    158156      ! 
    159       z2dt = 2. * rdt                                 ! set time step size (Euler/Leapfrog) 
    160       IF( neuler == 0 .AND. kt == nit000 )   z2dt =rdt 
     157      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
     158      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
    161159 
    162160      !                                           !------------------------------! 
    163161      !                                           !   After Sea Surface Height   ! 
    164162      !                                           !------------------------------! 
    165       zhdiv(:,:) = 0.e0 
     163      zhdiv(:,:) = 0._wp 
    166164      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    167165        zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 
     
    171169      ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp 
    172170      z1_rau0 = 0.5 / rau0 
    173       ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) & 
    174       &                      * tmask(:,:,1) 
     171      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    175172 
    176173#if defined key_agrif 
    177       CALL agrif_ssh(kt) 
     174      CALL agrif_ssh( kt ) 
    178175#endif 
    179176#if defined key_obc 
    180177      IF( Agrif_Root() ) THEN  
    181178         ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
    182          CALL lbc_lnk( ssha, 'T', 1. )                ! absolutly compulsory !! (jmm) 
     179         CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm) 
    183180      ENDIF 
    184181#endif 
     
    200197            END DO 
    201198         END DO 
    202          ! Boundaries conditions 
    203          CALL lbc_lnk( sshu_a, 'U', 1. ) 
    204          CALL lbc_lnk( sshv_a, 'V', 1. ) 
    205       ENDIF 
    206 ! Include the IAU weighted SSH increment 
     199         CALL lbc_lnk( sshu_a, 'U', 1. )   ;   CALL lbc_lnk( sshv_a, 'V', 1. )      ! Boundaries conditions 
     200      ENDIF 
     201       
    207202#if defined key_asminc 
    208       IF( ( lk_asminc ).AND.( ln_sshinc ).AND.( ln_asmiau ) ) THEN 
     203      !                                                ! Include the IAU weighted SSH increment 
     204      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    209205         CALL ssh_asm_inc( kt ) 
    210206         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
     
    218214      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence 
    219215         ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise 
    220          wn(:,:,jk) = wn(:,:,jk+1) -    fse3t_n(:,:,jk) * hdivn(:,:,jk)        & 
    221             &                      - (  fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
     216         wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        & 
     217            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    & 
    222218            &                         * tmask(:,:,jk) * z1_2dt 
    223219#if defined key_bdy 
     
    281277 
    282278      !                       !--------------------------! 
    283       IF( lk_vvl ) THEN       !  Variable volume levels  ! 
     279      IF( lk_vvl ) THEN       !  Variable volume levels  !     (ssh at t-, u-, v, f-points) 
    284280         !                    !--------------------------! 
    285281         ! 
    286          ! ssh at t-, u-, v, f-points 
    287          !=========================== 
    288          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter 
    289             sshn  (:,:) = ssha  (:,:)                        ! now <-- after  (before already = now) 
     282         IF( neuler == 0 .AND. kt == nit000 ) THEN    !** Euler time-stepping at first time-step : no filter 
     283            sshn  (:,:) = ssha  (:,:)                       ! now <-- after  (before already = now) 
    290284            sshu_n(:,:) = sshu_a(:,:) 
    291285            sshv_n(:,:) = sshv_a(:,:) 
    292             DO jj = 1, jpjm1 
    293                DO ji = 1, jpim1      ! NO Vector Opt. 
    294                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    295                      &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    296                      &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
    297                      &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
    298                END DO 
    299             END DO 
    300             ! Boundaries conditions 
    301             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    302          ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap 
    303             zec = atfp * rdt / rau0 
    304             DO jj = 1, jpj 
    305                DO ji = 1, jpi                                ! before <-- now filtered 
    306                   sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   & 
    307                      &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 
    308                   sshn  (ji,jj) = ssha  (ji,jj)              ! now <-- after 
    309                   sshu_n(ji,jj) = sshu_a(ji,jj) 
    310                   sshv_n(ji,jj) = sshv_a(ji,jj) 
    311                END DO 
    312             END DO 
    313             DO jj = 1, jpjm1 
     286            DO jj = 1, jpjm1                                ! ssh now at f-point 
    314287               DO ji = 1, jpim1      ! NO Vector Opt. 
    315288                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 & 
     
    319292               END DO 
    320293            END DO 
    321             ! Boundaries conditions 
    322             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    323             DO jj = 1, jpjm1 
     294            CALL lbc_lnk( sshf_n, 'F', 1. )                 ! Boundaries conditions 
     295            ! 
     296         ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap 
     297            zec = atfp * rdt / rau0 
     298            DO jj = 1, jpj 
     299               DO ji = 1, jpi                               ! before <-- now filtered 
     300                  sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   & 
     301                     &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 
     302                  sshn  (ji,jj) = ssha  (ji,jj)             ! now <-- after 
     303                  sshu_n(ji,jj) = sshu_a(ji,jj) 
     304                  sshv_n(ji,jj) = sshv_a(ji,jj) 
     305               END DO 
     306            END DO 
     307            DO jj = 1, jpjm1                                ! ssh now at f-point 
     308               DO ji = 1, jpim1      ! NO Vector Opt. 
     309                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 & 
     310                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     311                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     312                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     313               END DO 
     314            END DO 
     315            CALL lbc_lnk( sshf_n, 'F', 1. )                 ! Boundaries conditions 
     316            ! 
     317            DO jj = 1, jpjm1                                ! ssh before at u- & v-points 
    324318               DO ji = 1, jpim1      ! NO Vector Opt. 
    325319                  sshu_b(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   & 
     
    331325               END DO 
    332326            END DO 
    333             ! Boundaries conditions 
    334327            CALL lbc_lnk( sshu_b, 'U', 1. ) 
    335             CALL lbc_lnk( sshv_b, 'V', 1. ) 
     328            CALL lbc_lnk( sshv_b, 'V', 1. )            !  Boundaries conditions 
     329            ! 
    336330         ENDIF 
    337331         !                    !--------------------------! 
    338       ELSE                    !        fixed levels      ! 
     332      ELSE                    !        fixed levels      !     (ssh at t-point only) 
    339333         !                    !--------------------------! 
    340334         ! 
    341          ! ssh at t-point only 
    342          !==================== 
    343          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter 
    344             sshn(:,:) = ssha(:,:)                            ! now <-- after  (before already = now) 
    345             ! 
    346          ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap 
     335         IF( neuler == 0 .AND. kt == nit000 ) THEN    !** Euler time-stepping at first time-step : no filter 
     336            sshn(:,:) = ssha(:,:)                           ! now <-- after  (before already = now) 
     337            ! 
     338         ELSE                                               ! Leap-Frog time-stepping: Asselin filter + swap 
    347339            DO jj = 1, jpj 
    348                DO ji = 1, jpi                                ! before <-- now filtered 
     340               DO ji = 1, jpi                               ! before <-- now filtered 
    349341                  sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) 
    350                   sshn(ji,jj) = ssha(ji,jj)                  ! now <-- after 
     342                  sshn(ji,jj) = ssha(ji,jj)                 ! now <-- after 
    351343               END DO 
    352344            END DO 
Note: See TracChangeset for help on using the changeset viewer.