Changeset 1829


Ignore:
Timestamp:
2010-04-12T14:53:52+02:00 (11 years ago)
Author:
cetlod
Message:

New option to have R-B-G light penetration with 3D chlorophyll data

  • new module dtachl.F90 to read 3D monthly climatological chlorophyll data
  • update traqsr.F90 to add the new option
Location:
branches/CMIP5_IPSL/NEMO/OPA_SRC
Files:
1 added
1 edited

Legend:

Unmodified
Added
Removed
  • branches/CMIP5_IPSL/NEMO/OPA_SRC/TRA/traqsr.F90

    r1756 r1829  
    2727   USE iom             ! I/O manager 
    2828   USE fldread         ! read input fields 
     29   USE dtachl 
    2930 
    3031   IMPLICIT NONE 
     
    3839   LOGICAL , PUBLIC ::   ln_qsr_2bd = .TRUE.    !: 2 band         light absorption flag 
    3940   LOGICAL , PUBLIC ::   ln_qsr_bio = .FALSE.   !: bio-model      light absorption flag 
    40    INTEGER , PUBLIC ::   nn_chldta  = 0         !: use Chlorophyll data (=1) or not (=0) 
     41   INTEGER , PUBLIC ::   nn_chldta  = 0         !: use Chlorophyll 2D data (=1) 3D data (=2) or not (=0) 
    4142   REAL(wp), PUBLIC ::   rn_abs     = 0.58_wp   !: fraction absorbed in the very near surface (RGB & 2 bands) 
    4243   REAL(wp), PUBLIC ::   rn_si0     = 0.35_wp   !: very near surface depth of extinction      (RGB & 2 bands) 
    4344   REAL(wp), PUBLIC ::   rn_si1     = 23.0_wp   !: deepest depth of extinction (water type I)       (2 bands) 
    4445   REAL(wp), PUBLIC ::   rn_si2     = 61.8_wp   !: deepest depth of extinction (blue & 0.01 mg.m-3)     (RGB) 
    45     
     46 
    4647   ! Module variables 
    4748   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
     
    9697      REAL(wp) ::   zchl, zcoef, zsi0r   ! temporary scalars 
    9798      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         - 
    98       REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace 
     99      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb2, zekg2, zekr2            ! 2D workspace 
     100      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekb3, zekg3, zekr3            ! 3D workspace 
    99101      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace 
    100102      !!---------------------------------------------------------------------- 
     
    133135            !                                             ! ------------------------- ! 
    134136            ! Set chlorophyl concentration 
    135             IF( nn_chldta ==1 ) THEN                             !* Variable Chlorophyll 
     137            IF( nn_chldta == 1 ) THEN                             !*  2D Variable Chlorophyll 
    136138               ! 
    137139               CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step 
    138140               !          
    139 !CDIR COLLAPSE 
     141!CDIR COLLAPSE  
    140142!CDIR NOVERRCHK 
    141143               DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl 
     
    144146                     zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj) ) ) 
    145147                     irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
    146                      zekb(ji,jj) = rkrgb(1,irgb) 
    147                      zekg(ji,jj) = rkrgb(2,irgb) 
    148                      zekr(ji,jj) = rkrgb(3,irgb) 
     148                     zekb2(ji,jj) = rkrgb(1,irgb) 
     149                     zekg2(ji,jj) = rkrgb(2,irgb) 
     150                     zekr2(ji,jj) = rkrgb(3,irgb) 
    149151                  END DO 
    150152               END DO 
     
    161163!CDIR NOVERRCHK 
    162164                  DO jj = 1, jpj 
     165!CDIR NOVERRCHK 
     166                     DO ji = 1, jpi 
     167                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zsi0r     ) 
     168                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb2(ji,jj) ) 
     169                        zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg2(ji,jj) ) 
     170                        zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr2(ji,jj) ) 
     171                        ze0(ji,jj,jk) = zc0 
     172                        ze1(ji,jj,jk) = zc1 
     173                        ze2(ji,jj,jk) = zc2 
     174                        ze3(ji,jj,jk) = zc3 
     175                        zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk) 
     176                     END DO 
     177                  END DO 
     178               END DO 
     179               ! 
     180               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
     181                  ta(:,:,jk) = ta(:,:,jk) + ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t(:,:,jk) 
     182               END DO 
     183               zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero 
     184               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution 
     185               ! 
     186            ! Set chlorophyl concentration 
     187            ELSE IF( nn_chldta == 2) THEN                             !*  3D Variable Chlorophyll 
     188               ! 
     189               CALL dta_chl( kt ) 
     190               !          
     191               DO jk = 1, jpkm1                                         ! Separation in R-G-B depending of the surface Chl 
     192!CDIR NOVERRCHK 
     193                 DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl 
     194!CDIR NOVERRCHK 
     195                   DO ji = 1, jpi 
     196                     zchl = MIN( 10. , MAX( 0.03, chl_dta(ji,jj,jk) ) ) 
     197                     irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
     198                     zekb3(ji,jj,jk) = rkrgb(1,irgb) * fse3t(ji,jj,jk) 
     199                     zekg3(ji,jj,jk) = rkrgb(2,irgb) * fse3t(ji,jj,jk) 
     200                     zekr3(ji,jj,jk) = rkrgb(3,irgb) * fse3t(ji,jj,jk) 
     201                   END DO 
     202                 END DO 
     203               ENDDO 
     204               ! 
     205               zsi0r = 1.e0 / rn_si0 
     206               zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B 
     207               ze0(:,:,1) = rn_abs  * qsr(:,:) 
     208               ze1(:,:,1) = zcoef * qsr(:,:) 
     209               ze2(:,:,1) = zcoef * qsr(:,:) 
     210               ze3(:,:,1) = zcoef * qsr(:,:) 
     211               zea(:,:,1) =         qsr(:,:) 
     212               ! 
     213               DO jk = 2, nksr+1 
     214!CDIR NOVERRCHK 
     215                  DO jj = 1, jpj 
    163216!CDIR NOVERRCHK    
    164217                     DO ji = 1, jpi 
    165218                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zsi0r     ) 
    166                         zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) ) 
    167                         zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) ) 
    168                         zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr(ji,jj) ) 
     219                        zc1 = ze1(ji,jj,jk-1) * EXP( - zekb3(ji,jj,jk-1) ) 
     220                        zc2 = ze2(ji,jj,jk-1) * EXP( - zekg3(ji,jj,jk-1) ) 
     221                        zc3 = ze3(ji,jj,jk-1) * EXP( - zekr3(ji,jj,jk-1) ) 
    169222                        ze0(ji,jj,jk) = zc0 
    170223                        ze1(ji,jj,jk) = zc1 
     
    261314         WRITE(numout,*) '~~~~~~~~~~~~' 
    262315         WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration' 
    263          WRITE(numout,*) '      Light penetration (T) or not (F)         ln_traqsr  = ', ln_traqsr 
    264          WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration   ln_qsr_rgb = ', ln_qsr_rgb 
    265          WRITE(numout,*) '      2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd 
    266          WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
    267          WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta 
    268          WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 
    269          WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    270          WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
    271          WRITE(numout,*) '      3 bands: longest depth of extinction         rn_si2 = ', rn_si2 
     316         WRITE(numout,*) '      Light penetration (T) or not (F)                 ln_traqsr  = ', ln_traqsr 
     317         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration           ln_qsr_rgb = ', ln_qsr_rgb 
     318         WRITE(numout,*) '      2 band               light penetration           ln_qsr_2bd = ', ln_qsr_2bd 
     319         WRITE(numout,*) '      bio-model            light penetration           ln_qsr_bio = ', ln_qsr_bio 
     320         WRITE(numout,*) '      RGB : Chl 2D/3D data (=1/2) or cst value (=0)    nn_chldta  = ', nn_chldta 
     321         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)        rn_abs = ', rn_abs 
     322         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction      rn_si0 = ', rn_si0 
     323         WRITE(numout,*) '      2 bands: longest depth of extinction             rn_si1 = ', rn_si1 
     324         WRITE(numout,*) '      3 bands: longest depth of extinction             rn_si2 = ', rn_si2 
    272325      ENDIF 
    273326 
     
    278331            ln_qsr_bio = .FALSE. 
    279332         ENDIF 
     333         IF( .NOT.lk_dtachl .AND. ln_qsr_rgb .AND. nn_chldta == 2 ) THEN  
     334            CALL ctl_stop( 'You want to use a Chl 3D data to force your light penetration', & 
     335            &              'key_dtachl is required in compilation '      ) 
     336         ENDIF 
    280337         ! 
    281338         ioptio = 0                      ! Parameter control 
     
    284341         IF( ln_qsr_bio  )   ioptio = ioptio + 1 
    285342         ! 
    286          IF( ioptio /= 1 ) THEN 
    287             ln_qsr_rgb = .TRUE. 
    288             nn_chldta  = 0 
    289             ln_qsr_2bd = .FALSE. 
    290             ln_qsr_bio = .FALSE. 
    291             CALL ctl_warn( '          Choose ONE type of light penetration in namelist namtra_qsr',   & 
    292            &               ' otherwise, we force the model to run with RGB light penetration' ) 
    293          ENDIF 
     343         IF( ioptio /= 1 )  & 
     344            CALL ctl_stop( '          Choose ONE type of light penetration in namelist namtra_qsr' ) 
    294345         ! 
    295346         IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr =  1  
    296347         IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr =  2 
    297          IF( ln_qsr_2bd                      )   nqsr =  3 
    298          IF( ln_qsr_bio                      )   nqsr =  4 
     348         IF( ln_qsr_rgb .AND. nn_chldta == 2 )   nqsr =  3 
     349         IF( ln_qsr_2bd                      )   nqsr =  4  
     350         IF( ln_qsr_bio                      )   nqsr =  5 
    299351         ! 
    300352         IF(lwp) THEN                   ! Print the choice 
    301353            WRITE(numout,*) 
    302354            IF( nqsr ==  1 )   WRITE(numout,*) '         R-G-B  light penetration - Constant Chlorophyll' 
    303             IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B  light penetration - Chl data ' 
    304             IF( nqsr ==  3 )   WRITE(numout,*) '         2 band light penetration' 
    305             IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration' 
     355            IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B  light penetration - 2D Chl data ' 
     356            IF( nqsr ==  3 )   WRITE(numout,*) '         R-G-B  light penetration - 3D Chl data ' 
     357            IF( nqsr ==  4 )   WRITE(numout,*) '         2 band light penetration' 
     358            IF( nqsr ==  5 )   WRITE(numout,*) '         bio-model light penetration' 
    306359         ENDIF 
    307360         ! 
     
    328381            ! 
    329382            IF( nn_chldta == 1 ) THEN           !* Chl data : set sf_chl structure 
    330                IF(lwp) WRITE(numout,*) 
     383             IF(lwp) WRITE(numout,*) 
    331384               IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file' 
    332385               ALLOCATE( sf_chl(1), STAT=ierror ) 
     
    339392               CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   & 
    340393                  &                                         'Solar penetration function of read chlorophyll', 'namtra_qsr' ) 
    341                ! 
     394               !  
    342395            ELSE                                !* constant Chl : compute once for all the distribution of light (etot3) 
    343396               IF(lwp) WRITE(numout,*) 
Note: See TracChangeset for help on using the changeset viewer.