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 13576 for branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 – NEMO

Ignore:
Timestamp:
2020-10-09T12:35:11+02:00 (4 years ago)
Author:
dford
Message:

Update NEMO-FABM coupler for FABM v1, and introduce two-way NEMO-ERSEM coupling options. See https://code.metoffice.gov.uk/trac/utils/ticket/366.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r8059 r13576  
    3232   USE wrk_nemo       ! Memory Allocation 
    3333   USE timing         ! Timing 
     34#if defined key_fabm 
     35   USE trc, ONLY: trn  ! FABM variables 
     36   USE par_fabm        ! FABM parameters 
     37#endif 
    3438 
    3539   IMPLICIT NONE 
     
    4549   LOGICAL , PUBLIC ::   ln_qsr_bio   !: bio-model      light absorption flag 
    4650   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem) 
     51   LOGICAL , PUBLIC ::   ln_qsr_spec  !: spectral model heating from ERSEM 
    4752   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0) 
    4853   INTEGER , PUBLIC ::   nn_kd490dta  !: use kd490dta data (=1) or not (=0) 
     
    106111      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         - 
    107112      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr 
     113      REAL(wp), POINTER, DIMENSION(:,:,:) :: zekb_3d, zekg_3d, zekr_3d 
    108114      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
    109115      !!---------------------------------------------------------------------- 
     
    113119      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )  
    114120      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  
     121      CALL wrk_alloc( jpi, jpj, jpk, zekb_3d, zekg_3d, zekr_3d )   
    115122      ! 
    116123      IF( kt == nit000 ) THEN 
     
    150157       
    151158      !                                           ! ============================================== ! 
    152       IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  ! 
     159      IF( ln_qsr_spec ) THEN                      !  ERSEM spectral heating                        ! 
     160         !                                        ! ============================================== ! 
     161         DO jk = 1, jpkm1 
     162           qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) ) 
     163         END DO 
     164         !                                        Add to the general trend 
     165         DO jk = 1, jpkm1 
     166            DO jj = 2, jpjm1 
     167               DO ji = fs_2, fs_jpim1   ! vector opt. 
     168                  z1_e3t = zfact / fse3t(ji,jj,jk) 
     169                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t 
     170               END DO 
     171            END DO 
     172         END DO 
     173         zea(:,:,:) = etot3(:,:,:) * tmask(:,:,:) 
     174         DO jk = jpkm1, 1, -1 
     175            zea(:,:,jk) = zea(:,:,jk) + zea(:,:,jk+1) 
     176         END DO 
     177         CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution 
     178         IF ( ln_qsr_ice ) THEN 
     179            DO jj = 1, jpj 
     180               DO ji = 1, jpi 
     181                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
     182                     fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
     183                  ELSE 
     184                     fraqsr_1lev(ji,jj) = 1. 
     185                  ENDIF 
     186               END DO 
     187            END DO 
     188         ENDIF 
     189         !  
     190 
     191         !                                        ! ============================================== ! 
     192      ELSEIF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  ! 
    153193         !                                        ! ============================================== ! 
    154194         DO jk = 1, jpkm1 
     
    185225            !                                             ! ------------------------- ! 
    186226            ! Set chlorophyl concentration 
    187             IF( nn_chldta == 1 .OR. lk_vvl ) THEN            !*  Variable Chlorophyll or ocean volume 
    188                ! 
    189                IF( nn_chldta == 1 ) THEN                             !*  Variable Chlorophyll 
     227            IF( nn_chldta == 2 .OR. nn_chldta == 1 .OR. lk_vvl ) THEN   !*  Variable Chlorophyll or ocean volume 
     228               ! 
     229               IF( nn_chldta == 2 ) THEN 
     230                  DO jk = 1, nksr+1 
     231                     DO jj = 1, jpj 
     232                        DO ji = 1, jpi 
     233#if defined key_fabm 
     234                           zchl = trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) + trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) + & 
     235                              &   trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) + trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) 
     236#endif 
     237                           zchl = MIN(  10. , MAX( 0.03, zchl )  ) 
     238                           irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
     239                           !                                                          
     240                           zekb_3d(ji,jj,jk) = rkrgb(1,irgb) 
     241                           zekg_3d(ji,jj,jk) = rkrgb(2,irgb) 
     242                           zekr_3d(ji,jj,jk) = rkrgb(3,irgb) 
     243                        END DO 
     244                     END DO 
     245                  END DO 
     246                  ! 
     247               ELSEIF( nn_chldta == 1 ) THEN                             !*  Variable Chlorophyll 
    190248                  ! 
    191249                  CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step 
     
    219277               ! 
    220278               DO jk = 2, nksr+1 
     279                  IF( nn_chldta == 2 ) THEN 
     280                     zekb(:,:) = zekb_3d(:,:,jk) 
     281                     zekg(:,:) = zekg_3d(:,:,jk) 
     282                     zekr(:,:) = zekr_3d(:,:,jk) 
     283                  ENDIF 
    221284!CDIR NOVERRCHK 
    222285                  DO jj = 1, jpj 
     
    237300               ! clem: store attenuation coefficient of the first ocean level 
    238301               IF ( ln_qsr_ice ) THEN 
     302                  IF( nn_chldta == 2 ) THEN 
     303                     zekb(:,:) = zekb_3d(:,:,1) 
     304                     zekg(:,:) = zekg_3d(:,:,1) 
     305                     zekr(:,:) = zekr_3d(:,:,1) 
     306                  ENDIF 
    239307                  DO jj = 1, jpj 
    240308                     DO ji = 1, jpi 
     
    386454      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        )  
    387455      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  
     456      CALL wrk_dealloc( jpi, jpj, jpk, zekb_3d, zekg_3d, zekr_3d )  
    388457      ! 
    389458      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr') 
     
    423492      !! 
    424493      NAMELIST/namtra_qsr/  sn_chl, sn_kd490, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
    425          &                  nn_chldta, rn_abs, rn_si0, rn_si1, nn_kd490dta 
     494         &                  ln_qsr_spec, nn_chldta, rn_abs, rn_si0, rn_si1, nn_kd490dta 
    426495      !!---------------------------------------------------------------------- 
    427496 
     
    451520         WRITE(numout,*) '      2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd 
    452521         WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
     522         WRITE(numout,*) '      ERSEM spectral heating model             ln_qsr_spec= ', ln_qsr_spec 
    453523         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice 
    454          WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta = ', nn_chldta 
     524         WRITE(numout,*) '      RGB: model (2), file (1) or cst (0) chl   nn_chldta = ', nn_chldta 
    455525         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 
    456526         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
     
    470540         IF( ln_qsr_2bd  )   ioptio = ioptio + 1 
    471541         IF( ln_qsr_bio  )   ioptio = ioptio + 1 
     542         IF( ln_qsr_spec )   ioptio = ioptio + 1 
    472543         IF( nn_kd490dta == 1 )   ioptio = ioptio + 1 
    473544         ! 
     
    478549         IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr =  1  
    479550         IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr =  2 
    480          IF( ln_qsr_2bd                      )   nqsr =  3 
    481          IF( ln_qsr_bio                      )   nqsr =  4 
    482          IF( nn_kd490dta == 1                )   nqsr =  5 
     551         IF( ln_qsr_rgb .AND. nn_chldta == 2 )   nqsr =  3 
     552         IF( ln_qsr_2bd                      )   nqsr =  4 
     553         IF( ln_qsr_bio                      )   nqsr =  5 
     554         IF( nn_kd490dta == 1                )   nqsr =  6 
     555         IF( ln_qsr_spec                     )   nqsr =  7 
    483556         ! 
    484557         IF(lwp) THEN                   ! Print the choice 
    485558            WRITE(numout,*) 
    486559            IF( nqsr ==  1 )   WRITE(numout,*) '         R-G-B   light penetration - Constant Chlorophyll' 
    487             IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - Chl data ' 
    488             IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration' 
    489             IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration' 
    490             IF( nqsr ==  5 )   WRITE(numout,*) '         KD490 light penetration' 
    491          ENDIF 
     560            IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - Chl data from file' 
     561            IF( nqsr ==  3 )   WRITE(numout,*) '         R-G-B   light penetration - Chl data from model' 
     562            IF( nqsr ==  4 )   WRITE(numout,*) '         2 bands light penetration' 
     563            IF( nqsr ==  5 )   WRITE(numout,*) '         bio-model light penetration' 
     564            IF( nqsr ==  6 )   WRITE(numout,*) '         KD490 light penetration' 
     565            IF( nqsr ==  7 )   WRITE(numout,*) '         ERSEM spectral light penetration' 
     566         ENDIF 
     567#if ! defined key_fabm 
     568         ! 
     569         IF( nqsr ==  2 ) THEN 
     570            CALL ctl_stop( 'nn_chldta=2 so trying to use ERSEM chlorophyll for light penetration', & 
     571               &           'but not running with ERSEM' ) 
     572         ELSEIF( nqsr ==  7 ) THEN 
     573            CALL ctl_stop( 'ln_qsr_spec=.true. so trying to use ERSEM spectral light penetration', & 
     574               &           'but not running with ERSEM' ) 
     575         ENDIF 
     576#endif 
    492577         ! 
    493578      ENDIF 
     
    536621                  &                                         'Solar penetration function of read chlorophyll', 'namtra_qsr' ) 
    537622               ! 
     623            ELSEIF( nn_chldta == 2 ) THEN       !* Chl data will be got from model at each time step 
     624               IF(lwp) WRITE(numout,*) 
     625               IF(lwp) WRITE(numout,*) '        Chlorophyll will be taken from model at each time step' 
    538626            ELSE                                !* constant Chl : compute once for all the distribution of light (etot3) 
    539627               IF(lwp) WRITE(numout,*) 
Note: See TracChangeset for help on using the changeset viewer.