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/p4zfechem.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/p4zfechem.F90

    r13466 r13469  
    8989      ! Chemistry is supposed to be fast enough to be at equilibrium 
    9090      ! ------------------------------------------------------------ 
    91       DO jk = 1, jpkm1 
    92          DO jj = 1, jpj 
    93             DO ji = 1, jpi 
    94                zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
    95                zkeq            = fekeq(ji,jj,jk) 
    96                zfesatur        = zTL1(ji,jj,jk) * 1E-9 
    97                ztfe            = trb(ji,jj,jk,jpfer)  
    98                ! Fe' is the root of a 2nd order polynom 
    99                zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
    100                   &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       & 
    101                   &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
    102                zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
    103                zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 
    104            END DO 
    105          END DO 
    106       END DO 
     91      DO_3D_11_11( 1, jpkm1 ) 
     92         zTL1(ji,jj,jk)  = ztotlig(ji,jj,jk) 
     93         zkeq            = fekeq(ji,jj,jk) 
     94         zfesatur        = zTL1(ji,jj,jk) * 1E-9 
     95         ztfe            = trb(ji,jj,jk,jpfer)  
     96         ! Fe' is the root of a 2nd order polynom 
     97         zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
     98            &              + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       & 
     99            &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
     100         zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
     101         zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 
     102      END_3D 
    107103         ! 
    108104 
    109105      zdust = 0.         ! if no dust available 
    110       DO jk = 1, jpkm1 
    111          DO jj = 1, jpj 
    112             DO ji = 1, jpi 
    113                ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
    114                ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
    115                ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 
    116                ! -------------------------------------------------------------------------------------- 
    117                zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    118                fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    119                &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    120                &         + fesol(ji,jj,jk,5) / zhplus ) 
    121                ! 
    122                zfeequi = zFe3(ji,jj,jk) * 1E-9 
    123                zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
    124                ! precipitation of Fe3+, creation of nanoparticles 
    125                precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
    126                ! 
    127                ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    128                IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
    129                &  * EXP( -gdept_n(ji,jj,jk) / 540. ) 
    130                IF (ln_ligand) THEN 
    131                   zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) )) 
    132                ELSE 
    133                   zxlam  = xlam1 * 1.0 
    134                ENDIF 
    135                zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 
    136                zscave = zfeequi * zlam1b * xstep 
    137  
    138                ! Compute the different ratios for scavenging of iron 
    139                ! to later allocate scavenged iron to the different organic pools 
    140                ! --------------------------------------------------------- 
    141                zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b 
    142                zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b 
    143  
    144                !  Increased scavenging for very high iron concentrations found near the coasts  
    145                !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 
    146                !  ----------------------------------------------------------- 
    147                zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    148                zlamfac = MIN( 1.  , zlamfac ) 
    149                zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
    150                zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 
    151  
    152                !  Compute the coagulation of colloidal iron. This parameterization  
    153                !  could be thought as an equivalent of colloidal pumping. 
    154                !  It requires certainly some more work as it is very poorly constrained. 
    155                !  ---------------------------------------------------------------- 
    156                zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    157                    &      + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
    158                zaggdfea = zlam1a * xstep * zfecoll 
    159                ! 
    160                zlam1b   = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    161                zaggdfeb = zlam1b * xstep * zfecoll 
    162                ! 
    163                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 
    164                &                     - zcoag - precip(ji,jj,jk) 
    165                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 
    166                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 
    167                zscav3d(ji,jj,jk)   = zscave 
    168                zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
    169                ! 
    170             END DO 
    171          END DO 
    172       END DO 
     106      DO_3D_11_11( 1, jpkm1 ) 
     107         ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
     108         ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
     109         ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 
     110         ! -------------------------------------------------------------------------------------- 
     111         zhplus  = max( rtrn, hi(ji,jj,jk) ) 
     112         fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     113         &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     114         &         + fesol(ji,jj,jk,5) / zhplus ) 
     115         ! 
     116         zfeequi = zFe3(ji,jj,jk) * 1E-9 
     117         zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
     118         ! precipitation of Fe3+, creation of nanoparticles 
     119         precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
     120         ! 
     121         ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
     122         IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
     123         &  * EXP( -gdept_n(ji,jj,jk) / 540. ) 
     124         IF (ln_ligand) THEN 
     125            zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) )) 
     126         ELSE 
     127            zxlam  = xlam1 * 1.0 
     128         ENDIF 
     129         zlam1b = 3.e-5 + xlamdust * zdust + zxlam * ztrc 
     130         zscave = zfeequi * zlam1b * xstep 
     131 
     132         ! Compute the different ratios for scavenging of iron 
     133         ! to later allocate scavenged iron to the different organic pools 
     134         ! --------------------------------------------------------- 
     135         zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b 
     136         zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b 
     137 
     138         !  Increased scavenging for very high iron concentrations found near the coasts  
     139         !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 
     140         !  ----------------------------------------------------------- 
     141         zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
     142         zlamfac = MIN( 1.  , zlamfac ) 
     143         zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
     144         zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 
     145 
     146         !  Compute the coagulation of colloidal iron. This parameterization  
     147         !  could be thought as an equivalent of colloidal pumping. 
     148         !  It requires certainly some more work as it is very poorly constrained. 
     149         !  ---------------------------------------------------------------- 
     150         zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
     151             &      + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
     152         zaggdfea = zlam1a * xstep * zfecoll 
     153         ! 
     154         zlam1b   = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
     155         zaggdfeb = zlam1b * xstep * zfecoll 
     156         ! 
     157         tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 
     158         &                     - zcoag - precip(ji,jj,jk) 
     159         tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 
     160         tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 
     161         zscav3d(ji,jj,jk)   = zscave 
     162         zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
     163         ! 
     164      END_3D 
    173165      ! 
    174166      !  Define the bioavailable fraction of iron 
     
    178170      IF( ln_ligand ) THEN 
    179171         ! 
    180          DO jk = 1, jpkm1 
    181             DO jj = 1, jpj 
    182                DO ji = 1, jpi 
    183                   zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    184                       &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
    185                   ! 
    186                   zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    187                   zligco   = 0.5 * trn(ji,jj,jk,jplgw) 
    188                   zaggliga = zlam1a * xstep * zligco 
    189                   zaggligb = zlam1b * xstep * zligco 
    190                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 
    191                   zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
    192                END DO 
    193             END DO 
    194          END DO 
     172         DO_3D_11_11( 1, jpkm1 ) 
     173            zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
     174                &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
     175            ! 
     176            zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
     177            zligco   = 0.5 * trn(ji,jj,jk,jplgw) 
     178            zaggliga = zlam1a * xstep * zligco 
     179            zaggligb = zlam1b * xstep * zligco 
     180            tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 
     181            zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
     182         END_3D 
    195183         ! 
    196184         plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 
Note: See TracChangeset for help on using the changeset viewer.