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 775 for branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zflx.F90 – NEMO

Ignore:
Timestamp:
2007-12-19T14:45:15+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - PISCES in F90 : encapsulation of all p4z...F files in module F90 + doctor norme for local variables - compilation OK

File:
1 moved

Legend:

Unmodified
Added
Removed

  • branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zflx.F90

    r774 r775  
     1MODULE p4zflx 
     2   !!====================================================================== 
     3   !!                         ***  MODULE p4zflx  *** 
     4   !! TOP :   PISCES CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
     5   !!====================================================================== 
     6   !! History :    -   !  1988-07  (E. MAIER-REIMER) Original code 
     7   !!              -   !  1998     (O. Aumont) additions 
     8   !!              -   !  1999     (C. Le Quere) modifications 
     9   !!             1.0  !  2004     (O. Aumont) modifications 
     10   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     11   !!---------------------------------------------------------------------- 
     12#if defined key_pisces 
     13   !!---------------------------------------------------------------------- 
     14   !!   'key_pisces'                                       PISCES bio-model 
     15   !!---------------------------------------------------------------------- 
     16   !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
     17   !!---------------------------------------------------------------------- 
     18   USE oce_trc         ! 
     19   USE trp_trc 
     20   USE sms 
    121 
    2 CCC $Header$  
    3 CCC  TOP 1.0 , LOCEAN-IPSL (2005)  
    4 C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5 C --------------------------------------------------------------------------- 
    6 CDIR$ LIST 
    7       SUBROUTINE p4zflx 
    8 #if defined key_top && defined key_pisces 
    9 CCC--------------------------------------------------------------------- 
    10 CCC 
    11 CCC          ROUTINE p4zflx : PISCES MODEL 
    12 CCC          ***************************** 
    13 CCC 
    14 CCC 
    15 CC     PURPOSE. 
    16 CC     -------- 
    17 CC          *P4ZFLX* CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    18 CC 
    19 CC     EXTERNALS. 
    20 CC     ---------- 
    21 CC          NONE. 
    22 CC 
    23 CC   MODIFICATIONS: 
    24 CC   -------------- 
    25 CC      original      : 1988-07 E. MAIER-REIMER      MPI HAMBURG 
    26 CC      additions     : 1998    O. Aumont 
    27 CC      modifications : 1999    C. Le Quere 
    28 CC      modifications : 2004    O. Aumont 
    29 CC     ----------------------------------------------------------------- 
    30 CC  parameters and commons 
    31 CC ====================== 
    32 CDIR$ NOLIST 
    33       USE oce_trc 
    34       USE trp_trc 
    35       USE sms 
    36       IMPLICIT NONE 
    37 #include "domzgr_substitute.h90" 
    38 CDIR$ LIST 
    39 CC---------------------------------------------------------------------- 
    40 CC local declarations 
    41 CC ================== 
    42 C 
    43       INTEGER nspyr, ji, jj, krorr 
    44       REAL zpdtan 
    45       REAL kgco2(jpi,jpj),kgo2(jpi,jpj),h2co3(jpi,jpj) 
    46       REAL ttc, ws 
    47       REAL fld, flu, oxy16, flu16, zfact 
    48       REAL zph,ah2,zbot,zdic,zalk,schmitto2, zalka 
    49       REAL schmittco2 
    50 C 
    51 C 
    52 C  1. ASSIGNATION TO EXPONENTS IN THE LISS AND MERLIVAT 
    53 C     FORMULATION OF THE GAS EXCHANGE RATE 
    54 c ----------------------------------------------------- 
    55 C 
     22   IMPLICIT NONE 
     23   PRIVATE 
     24 
     25   PUBLIC   p4z_flx    ! called in p4zprg.F90 
     26 
     27   !!* Substitution 
     28#  include "domzgr_substitute.h90" 
     29   !!---------------------------------------------------------------------- 
     30   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     31   !! $Header:$  
     32   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     33   !!---------------------------------------------------------------------- 
     34 
     35CONTAINS 
     36 
     37   SUBROUTINE p4z_flx 
     38      !!--------------------------------------------------------------------- 
     39      !!                     ***  ROUTINE p4z_flx  *** 
     40      !! 
     41      !! ** Purpose :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
     42      !! 
     43      !! ** Method  : - ??? 
     44      !!--------------------------------------------------------------------- 
     45      INTEGER  ::   ji, jj, jrorr 
     46      REAL(wp) ::   zpdtan, zttc, zws 
     47      REAL(wp) ::   zfld, zflu, zoxy16, zflu16, zfact 
     48      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zschmitto2, zalka, zschmittco2 
     49      REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3 
     50      !!--------------------------------------------------------------------- 
     51 
     52      ! ----------------------------------------------------- 
     53      !     ASSIGNATION TO EXPONENTS IN THE LISS AND MERLIVAT 
     54      !     FORMULATION OF THE GAS EXCHANGE RATE 
     55      ! ----------------------------------------------------- 
     56 
    5657      zpdtan = raass / rdt 
    57       nspyr  = nint(zpdtan) 
    5858 
    59 C 
    60 C* 1.1 SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    61 C     SURFACE LAYER); THE RESULT OF THIS CALCULATION 
    62 C     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    63 C --------------------------------------------------- 
    64 C 
    65       DO krorr = 1,10 
    66 C 
    67         DO jj = 1,jpj 
    68           DO ji = 1,jpi 
    69 C 
    70 C* 1.2 DUMMY VARIABLES FOR DIC, H+, AND BORATE 
    71 C -------------------------------------------- 
    72 C 
    73         zbot = borat(ji,jj,1) 
    74         zfact = rhop(ji,jj,1)/1000.+rtrn 
    75         zdic  = trn(ji,jj,1,jpdic)/zfact 
    76         zph = max(hi(ji,jj,1),1.E-10)/zfact 
    77         zalka = trn(ji,jj,1,jptal)/zfact 
    78 C 
    79 C* 1.3 CALCULATE [ALK]([CO3--], [HCO3-]) 
    80 C ------------------------------------ 
    81 C 
    82         zalk=zalka- 
    83      &        (akw3(ji,jj,1)/zph-zph+zbot/(1.+zph/akb3(ji,jj,1))) 
    84 C 
    85 C* 1.4 CALCULATE [H+] AND [H2CO3] 
    86 C ----------------------------------------- 
    87 C 
    88          ah2=sqrt((zdic-zalk)**2+4*(zalk*ak23(ji,jj,1) 
    89      &     /ak13(ji,jj,1))*(2*zdic-zalk)) 
    90         ah2=0.5*ak13(ji,jj,1)/zalk*((zdic-zalk)+ah2) 
    91         h2co3(ji,jj) = (2*zdic-zalk)/(2.+ak13(ji,jj,1)/ah2)*zfact 
    92         hi(ji,jj,1)  = ah2*zfact 
    93           END DO 
    94         END DO 
     59      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
     60      !     SURFACE LAYER); THE RESULT OF THIS CALCULATION 
     61      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
     62 
     63      DO jrorr = 1, 10 
     64 
     65         DO jj = 1, jpj 
     66            DO ji = 1, jpi 
     67 
     68               ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
     69               zbot  = borat(ji,jj,1) 
     70               zfact = rhop(ji,jj,1) / 1000. + rtrn 
     71               zdic  = trn(ji,jj,1,jpdic) / zfact 
     72               zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
     73               zalka = trn(ji,jj,1,jptal) / zfact 
     74 
     75               ! CALCULATE [ALK]([CO3--], [HCO3-]) 
     76               zalk  = zalka - (  akw3(ji,jj,1) / zph - zph + zbot / ( 1.+ zph / akb3(ji,jj,1) )  ) 
     77 
     78               ! CALCULATE [H+] AND [H2CO3] 
     79               zah2   = SQRT(  (zdic-zalk)**2 + 4.* ( zalk * ak23(ji,jj,1)   & 
     80                  &                                        / ak13(ji,jj,1) ) * ( 2.* zdic - zalk )  ) 
     81               zah2   = 0.5 * ak13(ji,jj,1) / zalk * ( ( zdic - zalk ) + zah2 ) 
     82               zh2co3(ji,jj) = ( 2.* zdic - zalk ) / ( 2.+ ak13(ji,jj,1) / zah2 ) * zfact 
     83               hi(ji,jj,1)   = zah2 * zfact 
     84            END DO 
     85         END DO 
    9586      END DO 
    96 C 
    97 C 
    98 C 2. COMPUTE FLUXES 
    99 C -------------- 
    100 C 
    101 C 2.1 FIRST COMPUTE GAS EXCHANGE COEFFICIENTS 
    102 C ------------------------------------------- 
    103 C 
    104       DO jj = 1,jpj 
    105         DO ji = 1,jpi 
    106 C 
    107           ttc = min(35.,tn(ji,jj,1)) 
    108           schmittco2=2073.1-125.62*ttc+3.6276*ttc**2 
    109      &      -0.043126*ttc**3 
    110           ws=vatm(ji,jj) 
    111 C 
    112 C 2.2 COMPUTE GAS EXCHANGE FOR CO2 
    113 C -------------------------------- 
    114 C 
    115           kgco2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+ 
    116      &      ttc*0.00049946)))*sqrt(660./schmittco2) 
    117 C 
    118 C 2.3 CONVERT TO m/s, and apply sea-ice cover 
    119 C ----------------------------------------------------- 
    120 C 
    121           kgco2(ji,jj) = kgco2(ji,jj)/(100.*3600.) 
    122      &      *(1-freeze(ji,jj))*tmask(ji,jj,1) 
    123 #    if defined key_off_degrad 
    124      &        *facvol(ji,jj,1) 
    125 #    endif 
    126 C 
     87 
     88 
     89      ! -------------- 
     90      ! COMPUTE FLUXES 
     91      ! -------------- 
     92 
     93      ! FIRST COMPUTE GAS EXCHANGE COEFFICIENTS 
     94      ! ------------------------------------------- 
     95 
     96      DO jj = 1, jpj 
     97         DO ji = 1, jpi 
     98 
     99            zttc = MIN( 35., tn(ji,jj,1) ) 
     100!!gm  optimisation & more precise computation with factorisation of the polynome 
     101            zschmittco2 = 2073.1 - 125.62 * zttc + 3.6276 * zttc**2 - 0.043126 * zttc**3 
     102            zws         = vatm(ji,jj) 
     103 
     104            ! COMPUTE GAS EXCHANGE FOR CO2 
     105            zkgco2(ji,jj) = (  0.3 * zws * zws    & 
     106               &             + 2.5 * ( 0.5246 + zttc * ( 0.016256 + zttc * 0.00049946 ) )  )   & 
     107               &          * SQRT( 660./ zschmittco2 ) 
     108 
     109            ! CONVERT TO m/s, and apply sea-ice cover 
     110            zkgco2(ji,jj) = zkgco2(ji,jj) / ( 100. * 3600. )      & 
     111# if defined key_off_degrad 
     112               &         * facvol(ji,jj,1)      & 
     113# endif 
     114               &         * ( 1.- freeze(ji,jj) ) * tmask(ji,jj,1) 
     115 
    127116         END DO 
    128        END DO 
    129 C 
    130 C 2.5 COMPUTE GAS EXCHANGE COEFFICIENT FO O2 FROM 
    131 C      Waninkhof EQUATIONS 
    132 C ----------------------------------------------- 
    133 C 
    134        DO jj = 1,jpj 
    135          DO ji = 1,jpi 
    136 C 
    137           ws = vatm(ji,jj) 
    138           ttc = min(35.,tn(ji,jj,1)) 
    139           schmitto2 = 1953.4-128.0*ttc+3.9918*ttc**2 
    140      &      -0.050091*ttc**3 
     117      END DO 
    141118 
    142           kgo2(ji,jj) = (0.3*ws*ws + 2.5*(0.5246+ttc*(0.016256+ 
    143      &      ttc*0.00049946)))*sqrt(660./schmitto2) 
     119      ! COMPUTE GAS EXCHANGE COEFFICIENT FO O2 FROM Waninkhof EQUATIONS 
     120      DO jj = 1, jpj 
     121         DO ji = 1, jpi 
    144122 
    145 C 
    146 C CONVERT TO m/s AND APPLY SEA ICE COVER 
    147 C ------------------------------------- 
    148 C 
    149           kgo2(ji,jj) = kgo2(ji,jj)/(100.*3600.) 
    150      &      *(1-freeze(ji,jj))*tmask(ji,jj,1) 
    151 #    if defined key_off_degrad 
    152      &        *facvol(ji,jj,1) 
    153 #    endif 
    154 C 
    155          ENDDO 
    156        ENDDO 
    157 C 
    158        DO jj = 1,jpj 
    159          DO ji = 1,jpi 
    160 C 
    161 C Compute CO2 flux for the sea and air 
    162 C ------------------------------------ 
    163 C 
    164           fld = atcco2*tmask(ji,jj,1)*chemc(ji,jj,3)*kgco2(ji,jj) 
    165           flu = h2co3(ji,jj)*tmask(ji,jj,1)*kgco2(ji,jj) 
    166           tra(ji,jj,1,jpdic)= tra(ji,jj,1,jpdic)+(fld-flu) 
    167      &      /fse3t(ji,jj,1) 
    168 C 
    169 C Compute O2 flux  
    170 C --------------- 
    171 C 
    172           oxy16 = trn(ji,jj,1,jpoxy) 
    173           flu16 = (atcox*chemc(ji,jj,2)-oxy16)*kgo2(ji,jj) 
    174           tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy)+flu16 
    175      &      /fse3t(ji,jj,1) 
    176 C 
    177 C Save diagnostics 
    178 C ---------------- 
    179 C 
    180 #    if defined key_trc_diaadd 
    181           trc2d(ji,jj,1) = (fld-flu)*1000. 
    182           trc2d(ji,jj,2) = flu16*1000. 
    183           trc2d(ji,jj,3) = kgco2(ji,jj) 
    184           trc2d(ji,jj,4) = atcco2-h2co3(ji,jj)/(chemc(ji,jj,3)+rtrn) 
    185 #    endif 
    186 C 
    187         END DO 
     123          zws  = vatm(ji,jj) 
     124          zttc = MIN( 35., tn(ji,jj,1) ) 
     125!!gm  optimisation & more precise computation with factorisation of the polynome 
     126          zschmitto2   = 1953.4 - 128.0 * zttc + 3.9918 * zttc**2 - 0.050091 * zttc**3 
     127 
     128          zkgo2(ji,jj) = (  0.3 * zws * zws   & 
     129             &            + 2.5 * ( 0.5246 + zttc * ( 0.016256 + zttc * 0.00049946 ) )  )   & 
     130             &         * SQRT( 660./ zschmitto2 ) 
     131 
     132          ! CONVERT TO m/s AND APPLY SEA ICE COVER 
     133          zkgo2(ji,jj) = zkgo2(ji,jj) / ( 100.*3600.)        & 
     134# if defined key_off_degrad 
     135             &        * facvol(ji,jj,1)       & 
     136# endif 
     137             &        * ( 1.- freeze(ji,jj) ) *tmask(ji,jj,1) 
     138 
     139         END DO 
    188140      END DO 
    189 C 
    190 #endif 
    191       RETURN 
    192       END 
     141 
     142      DO jj = 1, jpj 
     143         DO ji = 1, jpi 
     144 
     145            ! Compute CO2 flux for the sea and air 
     146            zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,3) * zkgco2(ji,jj) 
     147            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
     148            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 
     149 
     150            ! Compute O2 flux  
     151            zoxy16 = trn(ji,jj,1,jpoxy) 
     152            zflu16 = ( atcox * chemc(ji,jj,2) - zoxy16 ) * zkgo2(ji,jj) 
     153            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zflu16 / fse3t(ji,jj,1) 
     154 
     155# if defined key_trc_diaadd 
     156            ! Save diagnostics 
     157            trc2d(ji,jj,1) = ( zfld - zflu ) * 1000. 
     158            trc2d(ji,jj,2) = zflu16 * 1000. 
     159            trc2d(ji,jj,3) = zkgco2(ji,jj) 
     160            trc2d(ji,jj,4) = atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,3) + rtrn ) 
     161# endif 
     162         END DO 
     163      END DO 
     164      ! 
     165   END SUBROUTINE p4z_flx 
     166 
     167#else 
     168   !!====================================================================== 
     169   !!  Dummy module :                                   No PISCES bio-model 
     170   !!====================================================================== 
     171CONTAINS 
     172   SUBROUTINE p4z_flx( kt )                   ! Empty routine 
     173      INTEGER, INTENT( in ) ::   kt 
     174      WRITE(*,*) 'p4z_flx: You should not have seen this print! error?', kt 
     175   END SUBROUTINE p4z_flx 
     176#endif  
     177 
     178   !!====================================================================== 
     179END MODULE  p4zflx 
Note: See TracChangeset for help on using the changeset viewer.