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 7162 for branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90 – NEMO

Ignore:
Timestamp:
2016-11-01T14:23:51+01:00 (7 years ago)
Author:
cetlod
Message:

new top interface : Add PISCES quota model

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r7068 r7162  
    2222   USE iom                          !  I/O manager 
    2323   USE fldread                      !  read input fields 
    24    USE sbc_oce, ONLY :  atm_co2     !  atmospheric pCO2                
    2524 
    2625   IMPLICIT NONE 
     
    4241 
    4342   !                               !!* nampisatm namelist (Atmospheric PRessure) * 
    44    LOGICAL, PUBLIC ::   ln_presatm  !: ref. pressure: global mean Patm (F) or a constant (F) 
    45  
    46    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:)  ::  patm      ! atmospheric pressure at kt                 [N/m2] 
    47    TYPE(FLD), ALLOCATABLE,       DIMENSION(:)    ::  sf_patm   ! structure of input fields (file informations, fields read) 
    48  
    49  
    50    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux  
     43   LOGICAL, PUBLIC ::   ln_presatm     !: ref. pressure: global mean Patm (F) or a constant (F) 
     44   LOGICAL, PUBLIC ::   ln_presatmco2  !: accounting for spatial atm CO2 in the compuation of carbon flux (T) or not (F) 
     45 
     46   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) ::  patm      ! atmospheric pressure at kt                 [N/m2] 
     47   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_patm   ! structure of input fields (file informations, fields read) 
     48   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_atmco2 ! structure of input fields (file informations, fields read) 
     49 
    5150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
    5251 
     
    6867      !! ** Method  :  
    6968      !!              - Include total atm P correction via Esbensen & Kushnir (1981)  
    70       !!              - Pressure correction NOT done for key_cpl_carbon_cycle 
    7169      !!              - Remove Wanninkhof chemical enhancement; 
    7270      !!              - Add option for time-interpolation of atcco2.txt   
     
    7977      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact 
    8078      REAL(wp) ::   zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff 
    81       REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
     79      REAL(wp) ::   zph, zdic, zsch_o2, zsch_co2 
    8280      REAL(wp) ::   zyr_dec, zdco2dt 
    8381      CHARACTER (len=25) :: charout 
     
    9492      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    9593 
    96       IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
    97  
    98       IF( ln_co2int ) THEN  
     94      IF( kt /= nit000 .AND. .NOT.l_co2cpl .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
     95 
     96      IF( ln_co2int .AND. .NOT.ln_presatmco2 .AND. .NOT.l_co2cpl ) THEN  
    9997         ! Linear temporal interpolation  of atmospheric pco2.  atcco2.txt has annual values. 
    10098         ! Caveats: First column of .txt must be in years, decimal  years preferably.  
     
    110108      ENDIF 
    111109 
    112  !    IF( ln_cpl_carbon_cycle )   satmco2(:,:) = atm_co2(:,:) 
    113  
    114       DO jm = 1, 10 
    115          DO jj = 1, jpj 
    116             DO ji = 1, jpi 
    117  
    118                ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
    119                zbot  = borat(ji,jj,1) 
    120                zfact = rhop(ji,jj,1) / 1000. + rtrn 
    121                zdic  = trb(ji,jj,1,jpdic) / zfact 
    122                zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
    123                zalka = trb(ji,jj,1,jptal) / zfact 
    124  
    125                ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    126                zalk  = zalka - (  akw3(ji,jj,1) / zph - zph / aphscale(ji,jj,1)    & 
    127                &       + zbot / ( 1.+ zph / akb3(ji,jj,1) )  ) 
    128  
    129                ! CALCULATE [H+] AND [H2CO3] 
    130                zah2   = SQRT(  (zdic-zalk)**2 + 4.* ( zalk * ak23(ji,jj,1)   & 
    131                   &                                        / ak13(ji,jj,1) ) * ( 2.* zdic - zalk )  ) 
    132                zah2   = 0.5 * ak13(ji,jj,1) / zalk * ( ( zdic - zalk ) + zah2 ) 
    133                zh2co3(ji,jj) = ( 2.* zdic - zalk ) / ( 2.+ ak13(ji,jj,1) / zah2 ) * zfact 
    134                hi(ji,jj,1)   = zah2 * zfact 
    135             END DO 
     110      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:) 
     111 
     112      DO jj = 1, jpj 
     113         DO ji = 1, jpi 
     114            ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
     115            zfact = rhop(ji,jj,1) / 1000. + rtrn 
     116            zdic  = trb(ji,jj,1,jpdic) 
     117            zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
     118            ! CALCULATE [H2CO3] 
     119            zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 
    136120         END DO 
    137121      END DO 
    138  
    139122 
    140123      ! -------------- 
     
    165148      END DO 
    166149 
     150 
    167151      DO jj = 1, jpj 
    168152         DO ji = 1, jpi 
    169             ztkel     = tsn(ji,jj,1,jp_tem) + 273.15 
    170             zsal      = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 
     153            ztkel = tempis(ji,jj,1) + 273.15 
     154            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
    171155            zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 
    172156            zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 
     
    269253         WRITE(numout,*) ' ' 
    270254      ENDIF 
    271       IF( .NOT.ln_co2int ) THEN 
     255     IF( .NOT.ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    272256         IF(lwp) THEN                         ! control print 
    273257            WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2 
     
    275259         ENDIF 
    276260         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    277       ELSE 
     261      ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    278262         IF(lwp)  THEN 
    279263            WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname ) 
     
    297281         END DO 
    298282         CLOSE(numco2) 
    299       ENDIF 
     283      ELSEIF( .NOT.ln_co2int .AND. ln_presatmco2 ) THEN 
     284         IF(lwp)  THEN 
     285            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file' 
     286            WRITE(numout,*) ' ' 
     287         ENDIF 
     288      ELSE 
     289         IF(lwp)  THEN 
     290            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file' 
     291            WRITE(numout,*) ' ' 
     292         ENDIF 
     293      ENDIF 
     294 
    300295      ! 
    301296      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
     
    323318      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
    324319      TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read 
    325       !! 
    326       NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir 
     320      TYPE(FLD_N)        ::  sn_atmco2 ! informations about the fields to be read 
     321      !! 
     322      NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir 
    327323 
    328324      !                                         ! ----------------------- ! 
     
    343339            WRITE(numout,*) '   Namelist nampisatm : Atmospheric Pressure as external forcing' 
    344340            WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm = ', ln_presatm 
     341            WRITE(numout,*) '      spatial atmopsheric CO2 for flux calcs  ln_presatmco2 = ', ln_presatmco2 
    345342            WRITE(numout,*) 
    346343         ENDIF 
     
    355352         ENDIF 
    356353         !                                          
     354         IF( ln_presatmco2 ) THEN 
     355            ALLOCATE( sf_atmco2(1), STAT=ierr )           !* allocate and fill sf_atmco2 (forcing structure) with sn_atmco2 
     356            IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_atmco2 structure' ) 
     357            ! 
     358            CALL fld_fill( sf_atmco2, (/ sn_atmco2 /), cn_dir, 'p4z_flx', 'Atmospheric co2 partial pressure ', 'nampisatm' ) 
     359                                   ALLOCATE( sf_atmco2(1)%fnow(jpi,jpj,1)   ) 
     360            IF( sn_atmco2%ln_tint )  ALLOCATE( sf_atmco2(1)%fdta(jpi,jpj,1,2) ) 
     361         ENDIF 
     362         ! 
    357363         IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file 
    358364         ! 
     
    364370      ENDIF 
    365371      ! 
     372      IF( ln_presatmco2 ) THEN 
     373         CALL fld_read( kt, 1, sf_atmco2 )               !* input atmco2 provided at kt + 1/2 
     374         satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1)                        ! atmospheric pressure 
     375      ELSE 
     376         satmco2(:,:) = atcco2    ! Initialize atmco2 if no reading from a file 
     377      ENDIF 
     378      ! 
    366379   END SUBROUTINE p4z_patm 
    367380 
     381 
    368382   INTEGER FUNCTION p4z_flx_alloc() 
    369383      !!---------------------------------------------------------------------- 
    370384      !!                     ***  ROUTINE p4z_flx_alloc  *** 
    371385      !!---------------------------------------------------------------------- 
    372       ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
     386      ALLOCATE( satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
    373387      ! 
    374388      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 
Note: See TracChangeset for help on using the changeset viewer.