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 13469 for NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsbc.F90 – NEMO

Ignore:
Timestamp:
2020-09-15T12:49:18+02:00 (4 years ago)
Author:
smasson
Message:

r4_trunk: first change of DO loops for routines to be merged, see #2523

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/temporary_r4_trunk/src/TOP/PISCES/P4Z/p4zsbc.F90

    r13466 r13469  
    126126            CALL fld_read( kt, 1, sf_river ) 
    127127            IF( ln_p4z ) THEN 
    128                DO jj = 1, jpj 
    129                   DO ji = 1, jpi 
    130                      zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
    131                      rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  & 
    132                         &              * 1.E3        / ( 12. * zcoef + rtrn ) 
    133                      rivdic(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  & 
    134                         &              * 1.E3         / ( 12. * zcoef + rtrn ) 
    135                      rivdin(ji,jj) =   sf_river(jr_din)%fnow(ji,jj,1)  & 
    136                         &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) 
    137                      rivdip(ji,jj) =   sf_river(jr_dip)%fnow(ji,jj,1)  & 
    138                         &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) 
    139                      rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  & 
    140                         &              * 1.E3        / ( 28.1 * zcoef + rtrn ) 
    141                      rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  & 
    142                         &              * 1.E3        / ( 12. * zcoef + rtrn )  
    143                   END DO 
    144                END DO 
     128               DO_2D_11_11 
     129                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
     130                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  & 
     131                     &              * 1.E3        / ( 12. * zcoef + rtrn ) 
     132                  rivdic(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)  & 
     133                     &              * 1.E3         / ( 12. * zcoef + rtrn ) 
     134                  rivdin(ji,jj) =   sf_river(jr_din)%fnow(ji,jj,1)  & 
     135                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) 
     136                  rivdip(ji,jj) =   sf_river(jr_dip)%fnow(ji,jj,1)  & 
     137                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) 
     138                  rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  & 
     139                     &              * 1.E3        / ( 28.1 * zcoef + rtrn ) 
     140                  rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  & 
     141                     &              * 1.E3        / ( 12. * zcoef + rtrn )  
     142               END_2D 
    145143            ELSE    !  ln_p5z 
    146                DO jj = 1, jpj 
    147                   DO ji = 1, jpi 
    148                      zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
    149                      rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    & 
    150                         &              * 1.E3        / ( 12. * zcoef + rtrn ) 
    151                      rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) & 
    152                         &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1) 
    153                      rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) & 
    154                         &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1) 
    155                      rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) & 
    156                         &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1) 
    157                      rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) & 
    158                         &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1) 
    159                      rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) & 
    160                         &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1) 
    161                      rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  & 
    162                         &              * 1.E3        / ( 28.1 * zcoef + rtrn ) 
    163                      rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  & 
    164                         &              * 1.E3        / ( 12. * zcoef + rtrn ) 
    165                   END DO 
    166                END DO 
     144               DO_2D_11_11 
     145                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
     146                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    & 
     147                     &              * 1.E3        / ( 12. * zcoef + rtrn ) 
     148                  rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) & 
     149                     &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1) 
     150                  rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) & 
     151                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1) 
     152                  rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) & 
     153                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1) 
     154                  rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) & 
     155                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1) 
     156                  rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) & 
     157                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1) 
     158                  rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)  & 
     159                     &              * 1.E3        / ( 28.1 * zcoef + rtrn ) 
     160                  rivdoc(ji,jj) =   sf_river(jr_doc)%fnow(ji,jj,1)  & 
     161                     &              * 1.E3        / ( 12. * zcoef + rtrn ) 
     162               END_2D 
    167163            ENDIF 
    168164         ENDIF 
     
    411407         IF(lwp) WRITE(numout,*) 
    412408         IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1) 
    413          DO jk = 1, ik50 
    414             DO jj = 2, jpjm1 
    415                DO ji = fs_2, fs_jpim1 
    416                   ze3t   = e3t_0(ji,jj,jk) 
    417                   zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   & 
    418                           + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   & 
    419                           + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   & 
    420                           + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) ) 
    421                   zsurfp = zsurfc * ze3t / e1e2t(ji,jj) 
    422                   ! estimation of the coastal slope : 5 km off the coast 
    423                   ze3t2 = ze3t * ze3t 
    424                   zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 ) 
    425                   ! 
    426                   zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp 
    427                END DO 
    428             END DO 
    429          END DO 
     409         DO_3D_00_00( 1, ik50 ) 
     410            ze3t   = e3t_0(ji,jj,jk) 
     411            zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   & 
     412                    + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   & 
     413                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   & 
     414                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) ) 
     415            zsurfp = zsurfc * ze3t / e1e2t(ji,jj) 
     416            ! estimation of the coastal slope : 5 km off the coast 
     417            ze3t2 = ze3t * ze3t 
     418            zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 ) 
     419            ! 
     420            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp 
     421         END_3D 
    430422         ! 
    431423         CALL lbc_lnk( 'p4zsbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    432424         ! 
    433          DO jk = 1, jpk 
    434             DO jj = 1, jpj 
    435                DO ji = 1, jpi 
    436                   zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 
    437                   zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
    438                   zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
    439                END DO 
    440             END DO 
    441          END DO 
     425         DO_3D_11_11( 1, jpk ) 
     426            zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 
     427            zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
     428            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
     429         END_3D 
    442430         ! Coastal supply of iron 
    443431         ! ------------------------- 
Note: See TracChangeset for help on using the changeset viewer.