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 1445 – NEMO

Changeset 1445


Ignore:
Timestamp:
2009-05-13T16:35:02+02:00 (15 years ago)
Author:
cetlod
Message:

add the use of bio-optical retroaction on dynamics when coupling with PISCES, see ticket:428

Location:
trunk/NEMO
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OFF_SRC/TRA/traqsr.F90

    r1152 r1445  
    2323 
    2424   !! * Shared module variables 
    25    LOGICAL, PUBLIC ::   ln_traqsr = .TRUE.   !: qsr flag (Default=T) 
    26  
    27    !! * Module variables 
    28    REAL(wp), PUBLIC ::  & !!! * penetrative solar radiation namelist * 
    29       xsi1 = 0.35_wp    ! first depth of extinction  
    30    LOGICAL , PUBLIC ::   ln_qsr_sms = .false. ! flag to use or not the biological fluxes for light 
     25   LOGICAL , PUBLIC ::   ln_traqsr  = .TRUE.    !: light absorption (qsr) flag 
     26   LOGICAL , PUBLIC ::   ln_qsr_bio = .FALSE.   !: bio-optical retroaction 
     27   REAL(wp), PUBLIC ::   rn_abs     = 0.58_wp   !: fraction absorbed in the very near surface (RGB & 2 bands) 
     28   REAL(wp), PUBLIC ::   rn_si0     = 0.35_wp   !: very near surface depth of extinction      (RGB & 2 bands) 
     29   REAL(wp), PUBLIC ::   rn_si2     = 61.8_wp   !: deepest depth of extinction (blue & 0.01 mg.m-3)     (RGB) 
    3130 
    3231 
    … …  
    5554      !!---------------------------------------------------------------------- 
    5655      !! * Local declarations 
    57  
    58       NAMELIST/namqsr/ ln_traqsr, xsi1 
     56      NAMELIST/namqsr/ ln_qsr_bio, rn_abs, rn_si0, rn_si2 
    5957      !!---------------------------------------------------------------------- 
    6058 
    … …  
    6462      READ   ( numnam, namqsr ) 
    6563 
     64      ln_qsr_bio = .FALSE. ! Offline mode : No retroaction on dynamics  
    6665      ! Parameter control and print 
    6766      ! --------------------------- 
    68       IF( ln_traqsr  ) THEN 
    69         IF ( lwp ) THEN 
     67      IF(lwp) THEN                ! control print 
    7068         WRITE(numout,*) 
    7169         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation' 
    7270         WRITE(numout,*) '~~~~~~~~~~~~' 
    7371         WRITE(numout,*) '    Namelist namqsr : set the parameter of penetration' 
    74          WRITE(numout,*) '        first depth of extinction        xsi1        = ',xsi1 
    75          WRITE(numout,*) '     Biological fluxes for light(Y/N) ln_qsr_sms  = ',ln_qsr_sms 
    76          WRITE(numout,*) ' ' 
    77         END IF 
    78       ELSE 
    79         IF ( lwp ) THEN 
    80          WRITE(numout,*) 
    81          WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration' 
    82          WRITE(numout,*) '~~~~~~~~~~~~' 
    83         END IF 
     72         WRITE(numout,*) '        bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
     73         WRITE(numout,*) '        RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 
     74         WRITE(numout,*) '        RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
     75         WRITE(numout,*) '        3 bands: longest depth of extinction         rn_si2 = ', rn_si2 
    8476      ENDIF 
    85  
    86       IF( xsi1 < 0.e0  ) & 
    87          CALL ctl_stop( '              0<xsi1 not satisfied' ) 
    88  
     77       
    8978 
    9079   END SUBROUTINE tra_qsr_init 

  • trunk/NEMO/OPA_SRC/TRA/traqsr.F90

    r1425 r1445  
    4343   REAL(wp), PUBLIC ::   rn_si2     = 61.8_wp   !: deepest depth of extinction (blue & 0.01 mg.m-3)     (RGB) 
    4444    
     45   ! Module variables 
    4546   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
     47   INTEGER ::   nksr   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     48   REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
    4649 
    4750   !! * Substitutions 
    … …  
    111114       
    112115      !                                           ! ============================================== ! 
    113       IF( lk_qsr_bio ) THEN                       !  bio-model fluxes  : all vertical coordinates  ! 
     116      IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  ! 
    114117         !                                        ! ============================================== ! 
    115118         DO jk = 1, jpkm1 
    … …  
    266269         WRITE(numout,*) '        3 bands: longest depth of extinction         rn_si2 = ', rn_si2 
    267270      ENDIF 
    268       !                         ! control consistency 
    269       IF( lk_qsr_bio .AND. .NOT.ln_qsr_bio ) THEN 
    270          ln_qsr_bio = .true. 
    271          CALL ctl_warn( 'Force bio-model light penetraton ln_qsr_bio  = TRUE ' ) 
    272       ENDIF 
    273271       
    274272      !                          ! ===================================== ! 

  • trunk/NEMO/OPA_SRC/trc_oce.F90

    r1423 r1445  
    1010   !!   trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration          
    1111   !!---------------------------------------------------------------------- 
     12   USE par_oce 
    1213   USE in_out_manager  ! I/O manager 
    1314   USE dom_oce         ! ocean space and time domain 
    1415 
    15 #if defined key_top && defined key_pisces 
    16    !!---------------------------------------------------------------------- 
    17    !!   'key_top'   &   'key_pisces'                       PISCES bio-model           
    18    !!---------------------------------------------------------------------- 
    19    USE sms_pisces , ONLY :   etot3    =>   etot3   !:  bio-model light absorption 
    20  
    2116   IMPLICIT NONE 
    2217   PRIVATE 
    2318 
    24    PUBLIC   trc_oce_rgb   ! routine called by p4zopt.F90 
    25     
    26    LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .TRUE.   !: bio-model light absorption flag 
    27     
    28 #else 
    29    !!---------------------------------------------------------------------- 
    30    !! Default option                          No bio-model light absorption       
    31    !!---------------------------------------------------------------------- 
    32    USE par_oce 
    33  
    34    IMPLICIT NONE 
    35    PRIVATE 
    36  
    37    PUBLIC   trc_oce_rgb   ! routine called by traqsr.F90 
    38     
    39    LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag 
     19   PUBLIC   trc_oce_rgb        ! routine called by traqsr.F90 
     20   PUBLIC   trc_oce_rgb_read   ! routine called by traqsr.F90 
     21   PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least 
    4022    
    4123   REAL(wp), PUBLIC , DIMENSION(jpi,jpj,jpk) ::   etot3   !: light absortion coefficient 
     24 
     25#if defined key_top && defined key_pisces 
     26   !!---------------------------------------------------------------------- 
     27   !!   'key_top'   &   'key_pisces'                       PISCES bio-model           
     28   !!---------------------------------------------------------------------- 
     29   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .TRUE.   !: bio-model light absorption flag 
     30#else 
     31   !!---------------------------------------------------------------------- 
     32   !! Default option                          No bio-model light absorption       
     33   !!---------------------------------------------------------------------- 
     34   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag 
    4235#endif 
    43  
    44    PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least 
    45  
    46    INTEGER, PUBLIC ::   nksr   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    47  
    48    REAL(wp), DIMENSION(3,61), PUBLIC ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
    4936 
    5037   !! * Substitutions 
    … …  
    5239   !!---------------------------------------------------------------------- 
    5340   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    54    !! $Id:$  
     41   !! $Id$  
    5542   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    5643   !!---------------------------------------------------------------------- 
    … …  
    7259      !! Reference  : Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 
    7360      !!---------------------------------------------------------------------- 
    74       REAL(wp), DIMENSION(3,61), INTENT(inout) ::   prgb   ! tabulated attenuation coefficient 
     61      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient 
    7562      !! 
    7663      INTEGER  ::   jc     ! dummy loop indice 
    … …  
    175162      !!                          attenuation coefficient (from JM Andre) 
    176163      !!---------------------------------------------------------------------- 
    177       REAL(wp), DIMENSION(3,61), INTENT(inout) ::   prgb   ! tabulated attenuation coefficient 
     164      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient 
    178165      !! 
    179166      INTEGER  ::   jchl, jband   ! dummy loop indices 
    180167      INTEGER  ::   numlight 
    181       REAL(wp) ::   ztoto 
     168      REAL(wp) ::   zchl 
    182169      CHARACTER(LEN=20) :: clname 
    183170      !!---------------------------------------------------------------------- 
    … …  
    186173      CALL ctlopn( numlight, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .TRUE., 1 ) 
    187174      DO jchl = 1, 61 
    188          READ(numlight,*) ztoto, ( prgb(jband,jchl), jband=1,3 ) 
     175         READ(numlight,*) zchl, ( prgb(jband,jchl), jband=1,3 ) 
    189176      END DO 
    190177      CLOSE( numlight ) 

  • trunk/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r1176 r1445  
    88   !!              -   !  1999-11  (C. Menkes, M.-A. Foujols) itabe initial 
    99   !!              -   !  2000-02  (M.A. Foujols) change x**y par exp(y*log(x)) 
    10    !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
     10   !!   NEMO      2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
     11   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  minor optimisation + style 
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_lobster 
    … …  
    4546      !! ** Method  :   local par is computed in w layers using light propagation 
    4647      !!              mean par in t layers are computed by integration 
     48      !! 
     49!!gm please remplace the '???' by true comments 
     50      !! ** Action  :   xpar   ??? 
     51      !!                neln   ??? 
     52      !!                xze    ??? 
    4753      !!--------------------------------------------------------------------- 
    4854      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
    49       INTEGER  ::   ji, jj, jk 
    50       REAL(wp) ::   zpig                                    ! total pigment 
    51       REAL(wp) ::   zkr                                     ! total absorption coefficient in red 
    52       REAL(wp) ::   zkg                                     ! total absorption coefficient in green 
     55      !! 
     56      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     57      CHARACTER (len=25) ::   charout   ! temporary character 
     58      REAL(wp) ::   zpig                ! log of the total pigment 
     59      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green 
     60      REAL(wp) ::   zcoef               ! temporary scalar 
    5361      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar100         ! irradiance at euphotic layer depth 
    5462      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar0m          ! irradiance just below the surface 
    5563      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zparr, zparg    ! red and green compound of par 
    5664 
    57       CHARACTER (len=25) :: charout 
    5865      !!--------------------------------------------------------------------- 
    5966 
    6067      IF( kt == nit000 ) THEN 
    6168         IF(lwp) WRITE(numout,*) 
    62          IF(lwp) WRITE(numout,*) ' trc_opt: LOBSTER optic-model' 
    63          IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     69         IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' 
     70         IF(lwp) WRITE(numout,*) ' ~~~~~~~ ' 
    6471      ENDIF 
    6572 
    66       ! determination of surface irradiance 
    67       ! ----------------------------------- 
    68       zpar0m (:,:)   = qsr   (:,:) * 0.43 
     73      !                                          ! surface irradiance 
     74      zpar0m (:,:)   = qsr   (:,:) * 0.43        ! ------------------ 
    6975      zpar100(:,:)   = zpar0m(:,:) * 0.01 
    7076      xpar   (:,:,1) = zpar0m(:,:) 
    71       zparr  (:,:,1) = 0.5 * zpar0m(:,:) 
    72       zparg  (:,:,1) = 0.5 * zpar0m(:,:) 
     77      zparr  (:,:,1) = zpar0m(:,:) * 0.5 
     78      zparg  (:,:,1) = zpar0m(:,:) * 0.5 
    7379 
     80!!gm optimisation : introduce zcoef and LOG computed once for all 
    7481 
    75       ! determination of xpar 
    76       ! --------------------- 
    77  
    78       DO jk = 2, jpk                     ! determination of local par in w levels 
     82      !                                          ! Photosynthetically Available Radiation (PAR) 
     83      zcoef = 12 * redf / rcchl / rpig           ! -------------------------------------- 
     84      DO jk = 2, jpk                                  ! local par at w-levels 
    7985         DO jj = 1, jpj 
    8086            DO ji = 1, jpi 
    81                zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * 12 * redf / rcchl / rpig 
    82                zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 
    83                zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 
     87!!gm           zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef 
     88!!gm           zkr  = xkr0 + xkrp * EXP( xlr * LOG(zpig) ) 
     89!!gm           zkg  = xkg0 + xkgp * EXP( xlg * LOG(zpig) ) 
     90               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  ) 
     91               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     92               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    8493               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) ) 
    8594               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) ) 
    … …  
    8796        END DO 
    8897      END DO 
    89  
    90       DO jk = 1, jpkm1                   ! mean par in t levels 
     98!!gm optimisation : suppress one division 
     99      DO jk = 1, jpkm1                                ! mean par at t-levels 
    91100         DO jj = 1, jpj 
    92101            DO ji = 1, jpi 
    93                zpig = MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * 12 * redf / rcchl / rpig 
    94                zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 
    95                zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 
    96                zparr(ji,jj,jk)    = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr*fse3t(ji,jj,jk) ) ) 
    97                zparg(ji,jj,jk)    = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg*fse3t(ji,jj,jk) ) ) 
     102               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  ) 
     103               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
     104               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
     105!!gm           zparr(ji,jj,jk) = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 
     106!!gm           zparg(ji,jj,jk) = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) 
     107               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 
     108               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) 
    98109               xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
    99110            END DO 
    … …  
    101112      END DO 
    102113 
    103       ! 3. Determination of euphotic layer depth 
    104       ! ---------------------------------------- 
    105  
    106       ! Euphotic layer bottom level 
    107       neln(:,:) = 1                                           ! initialisation of EL level 
    108       DO jk = 1, jpk 
     114      !                                          ! Euphotic layer 
     115      !                                          ! -------------- 
     116      neln(:,:) = 1                                   ! euphotic layer level 
     117      DO jk = 1, jpk                                  ! (i.e. 1rst T-level strictly below EL bottom) 
    109118         DO jj = 1, jpj 
    110119           DO ji = 1, jpi 
    111               IF( xpar(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk+1 ! 1rst T-level strictly below EL bottom 
    112               !                                                  ! nb. this is to ensure compatibility with 
    113               !                                                  ! nmld_trc definition in trd_mld_trc_zint 
     120              IF( xpar(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
     121              !                                       ! nb. this is to ensure compatibility with 
     122              !                                       ! nmld_trc definition in trd_mld_trc_zint 
    114123           END DO 
    115124         END DO 
    116       ENDDO 
    117  
    118       ! Euphotic layer depth 
     125      END DO 
     126      !                                               ! Euphotic layer depth 
    119127      DO jj = 1, jpj 
    120128         DO ji = 1, jpi 
    121             xze(ji,jj) = fsdepw( ji, jj, neln(ji,jj) )            ! exact EL depth 
     129            xze(ji,jj) = fsdepw(ji,jj,neln(ji,jj)) 
    122130         END DO 
    123       ENDDO  
     131      END DO  
    124132 
    125133 
    126       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     134      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
    127135         WRITE(charout, FMT="('opt')") 
    128          CALL prt_ctl_trc_info(charout) 
     136         CALL prt_ctl_trc_info( charout ) 
    129137         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    130138      ENDIF 
    131  
     139      ! 
    132140   END SUBROUTINE trc_opt 
    133141 

  • trunk/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r1329 r1445  
    22   !!====================================================================== 
    33   !!                         ***  MODULE p4zopt  *** 
    4    !! TOP :   PISCES Compute the light availability in the water column 
     4   !! TOP - PISCES : Compute the light availability in the water column 
    55   !!====================================================================== 
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
     8   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisaion 
     9   !!---------------------------------------------------------------------- 
     10#if defined  key_pisces 
    1011   !!---------------------------------------------------------------------- 
    1112   !!   'key_pisces'                                       PISCES bio-model 
    1213   !!---------------------------------------------------------------------- 
    13    !!   p4z_opt        :   Compute the light availability in the water column 
    14    !!---------------------------------------------------------------------- 
    15    USE trc 
    16    USE oce_trc         ! 
    17    USE trc 
    18    USE sms_pisces 
     14   !!   p4z_opt       : light availability in the water column 
     15   !!---------------------------------------------------------------------- 
     16   USE trc            ! tracer variables 
     17   USE oce_trc        ! tracer-ocean share variables 
     18   USE trc_oce        ! ocean-tracer share variables 
     19   USE sms_pisces     ! Source Minus Sink of PISCES 
    1920 
    2021   IMPLICIT NONE 
    2122   PRIVATE 
    2223 
    23    PUBLIC   p4z_opt   
    24  
    25    !! * Shared module variables 
    26    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    27       etot, enano, ediat,       &  !: PAR for phyto, nano and diat  
    28       emoy                         !: averaged PAR in the mixed layer 
    29  
    30    !! * Module variables 
    31    REAL(wp), DIMENSION(3,61)                ::   &   !: 
    32       xkrgb                 !: ??? 
    33  
     24   PUBLIC   p4z_opt   ! called in p4zbio.F90 module 
     25 
     26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etot, enano, ediat   !: PAR for phyto, nano and diat  
     27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   emoy                 !: averaged PAR in the mixed layer 
     28 
     29   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     30   REAL(wp) ::   & 
     31      parlux = 0.43 / 3.e0 
     32 
     33   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb  !: tabulated attenuation coefficients for RGB absorption 
     34    
    3435   !!* Substitution 
    3536#  include "domzgr_substitute.h90" 
    … …  
    5253      !!--------------------------------------------------------------------- 
    5354      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    54       INTEGER  ::   ji, jj, jk 
     55      INTEGER  ::   ji, jj, jk, jc 
    5556      INTEGER  ::   irgb 
    56       REAL(wp) ::   zchl, zparlux 
    57       REAL(wp) ::   zrlight , zblight , zglight 
     57      REAL(wp) ::   zchl, zxsi0r 
     58      REAL(wp) ::   zc0 , zc1 , zc2, zc3 
    5859      REAL(wp), DIMENSION(jpi,jpj)     ::   zdepmoy, zetmp 
    5960      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekg, zekr, zekb 
    60       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3 
    61       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3lum, ze4lum 
    62       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze5lum, ze6lum 
     61      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3, ze0 
    6362      !!--------------------------------------------------------------------- 
    6463 
    6564 
    66       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_opt_init      ! Initialization (first time-step only) 
     65      !                                        !* tabulated attenuation coef.  
     66      IF( kt * jnt == nittrc000 ) THEN 
     67         !                                ! level of light extinction 
     68         nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 
     69         IF(lwp) THEN 
     70           WRITE(numout,*) 
     71           WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
     72         ENDIF 
     73!!         CALL trc_oce_rgb( xkrgb )     ! tabulated attenuation coefficients 
     74         CALL trc_oce_rgb_read( xkrgb )     ! tabulated attenuation coefficients 
     75         etot (:,:,:) = 0.e0 
     76         enano(:,:,:) = 0.e0 
     77         ediat(:,:,:) = 0.e0 
     78         IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 
     79      ENDIF 
    6780 
    6881 
    6982!     Initialisation of variables used to compute PAR 
    7083!     ----------------------------------------------- 
    71       ze1 (:,:,:) = 0.e0 
    72       ze2 (:,:,:) = 0.e0 
    73       ze3 (:,:,:) = 0.e0 
    74       etot(:,:,:) = 0.e0 
    75          
    76       zparlux = 0.43 / 3. 
    77  
    78 !    IF activated, computation of the qsr for the dynamics 
    79 !    ----------------------------------------------------- 
    80       IF( ln_qsr_sms ) THEN 
    81          ze3lum(:,:,:) = 0.e0 
    82          ze4lum(:,:,:) = 0.e0 
    83          ze5lum(:,:,:) = 0.e0 
    84          ze6lum(:,:,:) = 0.e0 
     84      ze1 (:,:,jpk) = 0.e0 
     85      ze2 (:,:,jpk) = 0.e0 
     86      ze3 (:,:,jpk) = 0.e0 
     87 
     88      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
     89      DO jk = 1, jpkm1                         !  -------------------------------------------------------- 
     90!CDIR NOVERRCHK 
     91         DO jj = 1, jpj 
     92!CDIR NOVERRCHK 
     93            DO ji = 1, jpi 
     94               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
     95               zchl = MIN(  10. , MAX( 0.03, zchl )  ) 
     96               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
     97               !                                                          
     98               zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk) 
     99               zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk) 
     100               zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk) 
     101            END DO 
     102         END DO 
     103      END DO 
     104 
     105!!gm  Potential BUG  must discuss with Olivier about this implementation.... 
     106!!gm           the questions are : - PAR at T-point or mean PAR over T-level.... 
     107!!gm                               - shallow water: no penetration of light through the bottom.... 
     108 
     109 
     110      !                                        !* Photosynthetically Available Radiation (PAR) 
     111      !                                        !  -------------------------------------- 
     112!CDIR NOVERRCHK 
     113      DO jj = 1, jpj 
     114!CDIR NOVERRCHK 
     115         DO ji = 1, jpi 
     116            zc1 = parlux * qsr(ji,jj) * EXP( -0.5 * zekb(ji,jj,1) ) 
     117            zc2 = parlux * qsr(ji,jj) * EXP( -0.5 * zekg(ji,jj,1) ) 
     118            zc3 = parlux * qsr(ji,jj) * EXP( -0.5 * zekr(ji,jj,1) ) 
     119            ze1  (ji,jj,1) = zc1 
     120            ze2  (ji,jj,1) = zc2 
     121            ze3  (ji,jj,1) = zc3 
     122            etot (ji,jj,1) = (       zc1 +        zc2 +       zc3 ) 
     123            enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 
     124            ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 
     125         END DO 
     126      END DO 
     127 
     128     
     129      DO jk = 2, nksrp       
     130!CDIR NOVERRCHK 
     131         DO jj = 1, jpj 
     132!CDIR NOVERRCHK 
     133            DO ji = 1, jpi 
     134               zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) ) 
     135               zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) ) 
     136               zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) ) 
     137               ze1  (ji,jj,jk) = zc1 
     138               ze2  (ji,jj,jk) = zc2 
     139               ze3  (ji,jj,jk) = zc3 
     140               etot (ji,jj,jk) = (       zc1 +        zc2 +       zc3 ) 
     141               enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 
     142               ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 
     143            END DO 
     144         END DO 
     145      END DO 
     146 
     147      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics) 
     148         !                                     !  ------------------------ 
     149         zxsi0r = 1.e0 / rn_si0 
     150         ! 
     151         ze0  (:,:,1) = rn_abs * qsr(:,:) 
     152         ze1  (:,:,1) = parlux * qsr(:,:)             ! surface value : separation in R-G-B + near surface  
     153         ze2  (:,:,1) = parlux * qsr(:,:) 
     154         ze3  (:,:,1) = parlux * qsr(:,:) 
     155         etot3(:,:,1) =          qsr(:,:) * tmask(:,:,1) 
     156         ! 
     157         DO jk = 2, nksrp+1 
     158!CDIR NOVERRCHK 
     159            DO jj = 1, jpj 
     160!CDIR NOVERRCHK 
     161               DO ji = 1, jpi 
     162                  zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r ) 
     163                  zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) ) 
     164                  zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) ) 
     165                  zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) ) 
     166                  ze0(ji,jj,jk) = zc0 
     167                  ze1(ji,jj,jk) = zc1 
     168                  ze2(ji,jj,jk) = zc2 
     169                  ze3(ji,jj,jk) = zc3 
     170                  etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk) 
     171              END DO 
     172              ! 
     173            END DO 
     174            ! 
     175        END DO 
     176        ! 
    85177      ENDIF 
    86178 
    87       DO jk = 1, jpkm1 
    88          DO jj = 1, jpj 
    89             DO ji = 1, jpi 
    90  
    91 !     Separation in three light bands: red, green, blue 
    92 !     ------------------------------------------------- 
    93                zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
    94                zchl = MAX( 0.03, zchl ) 
    95                zchl = MIN( 10. , zchl ) 
    96                                                                                  
    97                irgb = INT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    98                                                                                  
    99                zekb(ji,jj,jk) = xkrgb(1,irgb) 
    100                zekg(ji,jj,jk) = xkrgb(2,irgb) 
    101                zekr(ji,jj,jk) = xkrgb(3,irgb) 
    102  
    103             END DO 
    104          END DO 
    105       END DO 
    106  
    107 !CDIR NOVERRCHK 
    108       DO jj = 1,jpj 
    109 !CDIR NOVERRCHK 
    110          DO ji = 1,jpi 
    111  
    112 !     Separation in three light bands: red, green, blue 
    113 !     ------------------------------------------------- 
    114  
    115             zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1) 
    116             zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1) 
    117             zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1) 
    118  
    119             ze1(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zblight) 
    120             ze2(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zglight) 
    121             ze3(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zrlight) 
    122  
    123          END DO 
    124       END DO 
    125  
    126 !CDIR NOVERRCHK 
    127       DO jk = 2, jpkm1 
    128 !CDIR NOVERRCHK 
    129           DO jj = 1, jpj 
    130 !CDIR NOVERRCHK 
    131             DO ji = 1, jpi 
    132  
    133 !     Separation in three light bands: red, green, blue 
    134 !     ------------------------------------------------- 
    135  
    136                zblight = 0.5 * ( zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   & 
    137                   &            + zekb(ji,jj,jk  ) * fse3t(ji,jj,jk  ) ) 
    138                zglight = 0.5 * ( zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   & 
    139                   &            + zekg(ji,jj,jk  ) * fse3t(ji,jj,jk  ) ) 
    140                zrlight = 0.5 * ( zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1)   & 
    141                   &            + zekr(ji,jj,jk  ) * fse3t(ji,jj,jk  ) ) 
    142  
    143                ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP(-zblight) 
    144                ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP(-zglight) 
    145                ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP(-zrlight) 
    146  
    147             END DO 
    148          END DO 
    149       END DO 
    150  
    151       etot(:,:,:) = ze1(:,:,:) + ze2(:,:,:) + ze3(:,:,:) 
    152       enano(:,:,:) = 2.1 * ze1(:,:,:) + 0.42 * ze2(:,:,:) + 0.4 * ze3(:,:,:) 
    153       ediat(:,:,:) = 1.6 * ze1(:,:,:) + 0.69 * ze2(:,:,:) + 0.7 * ze3(:,:,:) 
    154  
    155  
    156       IF( ln_qsr_sms ) THEN 
    157  
    158 !   In the following, the vertical attenuation of qsr for the dynamics is computed 
    159 !   ------------------------------------------------------------------------------ 
    160  
    161 !CDIR NOVERRCHK 
    162          DO jj = 1, jpj 
    163 !CDIR NOVERRCHK 
    164             DO ji = 1, jpi 
    165  
    166 !     Separation in three light bands: red, green, blue 
    167 !     ------------------------------------------------- 
    168  
    169                zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1) 
    170                zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1) 
    171                zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1) 
    172  
    173                ze3lum(ji,jj,1) = zparlux * qsr(ji,jj) 
    174                ze4lum(ji,jj,1) = zparlux * qsr(ji,jj) 
    175                ze5lum(ji,jj,1) = zparlux * qsr(ji,jj) 
    176                ze6lum(ji,jj,1) = (1.-3. * zparlux) * qsr(ji,jj) 
    177  
    178             END DO 
    179          END DO 
    180  
    181 !CDIR NOVERRCHK 
    182          DO jk = 2, jpkm1 
    183 !CDIR NOVERRCHK 
    184             DO jj = 1, jpj 
    185 !CDIR NOVERRCHK 
    186                DO ji = 1, jpi 
    187  
    188 !     Separation in three light bands: red, green, blue 
    189 !     ------------------------------------------------- 
    190  
    191                   zblight = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
    192                   zglight = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
    193                   zrlight = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 
    194  
    195                   ze3lum(ji,jj,jk) = ze3lum(ji,jj,jk-1) * EXP( -zblight ) 
    196                   ze4lum(ji,jj,jk) = ze4lum(ji,jj,jk-1) * EXP( -zglight ) 
    197                   ze5lum(ji,jj,jk) = ze5lum(ji,jj,jk-1) * EXP( -zrlight ) 
    198                   ze6lum(ji,jj,jk) = ze6lum(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) / xsi1 ) 
    199  
    200                END DO 
    201             END DO 
    202          END DO 
    203  
    204          etot3(:,:,:) = ze3lum(:,:,:) + ze4lum(:,:,:) + ze5lum(:,:,:) + ze6lum(:,:,:) 
    205  
    206       ENDIF 
    207  
    208 !     Computation of the euphotic depth 
    209 !     --------------------------------- 
    210       ! Euphotic layer bottom level 
    211       neln(:,:) = 1                                           ! initialisation of EL level 
     179      !                                        !* Euphotic depth and level 
     180      neln(:,:) = 1                            !  ------------------------ 
    212181      heup(:,:) = 300. 
    213182 
    214       DO jk = 2, jpkm1 
     183      DO jk = 2, nksrp 
    215184         DO jj = 1, jpj 
    216185           DO ji = 1, jpi 
    217186              IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )  THEN 
    218                  neln(ji,jj) = jk+1 ! 1rst T-level strictly below EL bottom 
    219               !                                                  ! nb. this is to ensure compatibility with 
    220               !                                                  ! nmld_trc definition in trd_mld_trc_zint 
    221                 heup(ji,jj) = fsdepw(ji,jj,jk+1)                 ! Euphotic layer depth 
    222              ENDIF 
    223           END DO 
     187                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
     188                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
     189                 heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth 
     190              ENDIF 
     191           END DO 
    224192        END DO 
    225      ENDDO 
     193      END DO 
    226194  
    227      heup(:,:) = MIN( 300., heup(:,:) ) 
    228  
    229 !    Computation of the mean light over the mixed layer depth 
    230 !    -------------------------------------------------------- 
    231  
    232       zdepmoy(:,:)   = 0.e0 
     195      heup(:,:) = MIN( 300., heup(:,:) ) 
     196 
     197      !                                        !* mean light over the mixed layer 
     198      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    233199      zetmp  (:,:)   = 0.e0 
    234200      emoy   (:,:,:) = 0.e0 
    235201 
    236       DO jk = 1, jpkm1 
    237          DO jj = 1, jpj 
     202      DO jk = 1, nksrp 
     203!CDIR NOVERRCHK 
     204         DO jj = 1, jpj 
     205!CDIR NOVERRCHK 
    238206            DO ji = 1, jpi 
    239207               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    … …  
    244212         END DO 
    245213      END DO 
    246  
     214      ! 
    247215      emoy(:,:,:) = etot(:,:,:) 
    248  
    249       DO jk = 1, jpkm1 
    250          DO jj = 1, jpj 
    251             DO ji = 1, jpi 
    252                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    253                   emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
    254                ENDIF 
    255             END DO 
    256          END DO 
    257       END DO 
    258  
     216      ! 
     217      DO jk = 1, nksrp 
     218!CDIR NOVERRCHK 
     219         DO jj = 1, jpj 
     220!CDIR NOVERRCHK 
     221            DO ji = 1, jpi 
     222               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) & 
     223       &           emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
     224            END DO 
     225         END DO 
     226      END DO 
    259227 
    260228# if defined key_trc_diaadd 
    261       trc2d(:,:,jp_pcs0_2d + 10) = heup(:,:) * tmask(:,:,1) 
     229      trc2d(:,:,  jp_pcs0_2d + 10) = heup (:,:) * tmask(:,:,1)      ! save for outputs 
    262230# endif 
    263231      ! 
    264232   END SUBROUTINE p4z_opt 
    265233 
    266    SUBROUTINE p4z_opt_init 
    267  
    268       !!---------------------------------------------------------------------- 
    269       !!                  ***  ROUTINE p4z_opt_init  *** 
    270       !! 
    271       !! ** Purpose :   Initialization of of the optical scheme 
    272       !! 
    273       !! ** Method  :   read the look up table for the optical coefficients 
    274       !! 
    275       !! ** input   :   xKRGB61 
    276       !! 
    277       !!---------------------------------------------------------------------- 
    278  
    279       INTEGER :: ichl, iband 
    280       INTEGER :: numlight 
    281       REAL(wp) ::   ztoto 
    282       CHARACTER(LEN=20) :: clname 
    283  
    284       !  FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE 
    285       !  A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT 
    286  
    287       clname = 'kRGB61.txt'  
    288       CALL ctlopn( numlight, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    289          &           1, numout, .TRUE., 1 ) 
    290  
    291       DO ichl = 1,61 
    292          READ(numlight,*) ztoto, ( xkrgb(iband,ichl), iband = 1,3 ) 
    293       END DO 
    294  
    295       CLOSE(numlight) 
    296  
    297       IF(lwp) THEN                         ! control print 
    298          WRITE(numout,*) ' ' 
    299          WRITE(numout,*) ' Initialization of the optical look-up table done' 
    300          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    301       ENDIF 
    302  
    303    END SUBROUTINE p4z_opt_init 
    304  
    305  
    306234#else 
    307    !!====================================================================== 
     235   !!---------------------------------------------------------------------- 
    308236   !!  Dummy module :                                   No PISCES bio-model 
    309    !!====================================================================== 
     237   !!---------------------------------------------------------------------- 
    310238CONTAINS 
    311239   SUBROUTINE p4z_opt                   ! Empty routine 

  • trunk/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r1288 r1445  
    55   !!---------------------------------------------------------------------- 
    66   !! History :   1.0  !  2000-02 (O. Aumont) original code 
     7   !!             3.2  !  2009-04 (C. Ethe & NEMO team) style 
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    1718   PUBLIC 
    1819 
    19    !!---------------------------------------------------------------------- 
    20    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    21    !! $Id$  
    22    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    23    !!---------------------------------------------------------------------- 
     20   !!*  Time variables 
     21   INTEGER  ::   nrdttrc           !: ??? 
     22   INTEGER  ::   ndayflxtr         !: ??? 
     23   REAL(wp) ::   rfact , rfactr    !: ??? 
     24   REAL(wp) ::   rfact2, rfact2r   !: ??? 
    2425 
    25    !!---------------------------------------------------------------------- 
    26    !! Variable for chemistry of the CO2 cycle 
    27    !! --------------------------------------------------------------------- 
    28    ! 
    29    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akb3, ak13, ak23, aksp, akw3             !: ??? 
    30    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hi, borat                                !: ??? 
     26   !!*  Biological parameters  
     27   REAL(wp) ::   part              !: ??? 
     28   REAL(wp) ::   rno3              !: ??? 
     29   REAL(wp) ::   o2ut              !: ??? 
     30   REAL(wp) ::   po4r              !: ??? 
     31   REAL(wp) ::   rdenit            !: ??? 
     32   REAL(wp) ::   o2nit             !: ??? 
     33   REAL(wp) ::   wsbio, wsbio2     !: ??? 
     34   REAL(wp) ::   xkmort            !: ??? 
     35   REAL(wp) ::   ferat3            !: ??? 
    3136 
    32    !!---------------------------------------------------------------------- 
    33    !!  Time variables 
    34    !! --------------------------------------------------------------------- 
    35    INTEGER  ::   nrdttrc, ndayflxtr       !: ??? 
    36    REAL(wp) ::   rfact, rfactr, rfact2, rfact2r   !: ??? 
     37   !!* Damping  
     38   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
     39                                   !: when initialize from a restart file  
    3740 
    38    !!--------------------------------------- 
    39    !!  Biological parameters  
    40    !! -------------------------------------- 
    41    ! 
    42    REAL(wp) ::   part, rno3, o2ut, po4r, rdenit, o2nit     !: ??? 
    43    REAL(wp) ::   wsbio, wsbio2, xkmort, ferat3                     !: ??? 
     41   !!*  Biological fluxes for light 
     42   INTEGER , DIMENSION(jpi,jpj)     ::   neln       !: number of T-levels + 1 in the euphotic layer 
     43   REAL(wp), DIMENSION(jpi,jpj)     ::   heup       !: euphotic layer depth 
    4444 
    45    !!--------------------------------------------- 
    46    !!  Biological fluxes for light 
    47    !!--------------------------------------------- 
    48    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   etot3                 !: ??? 
    49    INTEGER , DIMENSION(jpi,jpj)     ::   neln    !: number of levels in the euphotic layer 
    50    REAL(wp), DIMENSION(jpi,jpj)     ::   heup    !: euphotic layer depth 
     45   !!*  Biological fluxes for primary production 
     46   REAL(wp), DIMENSION(jpi,jpj)     ::   xksi       !: ??? 
     47   REAL(wp), DIMENSION(jpi,jpj)     ::   xksimax    !: ??? 
     48   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xnanono3   !: ??? 
     49   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiatno3   !: ??? 
     50   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xnanonh4   !: ??? 
     51   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiatnh4   !: ??? 
     52   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimphy    !: ??? 
     53   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimdia    !: ??? 
     54   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   concdfe    !: ??? 
     55   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   concnfe    !: ??? 
    5156 
    52    !!---------------------------------------------------------- 
    53    !!  Biological fluxes for primary production 
    54    !!---------------------------------------------------------- 
    55    REAL(wp), DIMENSION(jpi,jpj) :: xksi, xksimax 
    56    ! 
    57    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xnanono3, xdiatno3, xnanonh4, xdiatnh4       !: ??? 
    58    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimphy, xlimdia, concdfe, concnfe !: ??? 
     57   !!*  SMS for the organic matter 
     58   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xfracal    !: ?? 
     59   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   nitrfac    !: ?? 
     60   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimbac    !: ?? 
     61   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiss      !: ?? 
    5962 
    60    !!--------------------------------------------- 
    61    !!  SMS for the organic matter 
    62    !!--------------------------------------------- 
    63    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xfracal, nitrfac, xlimbac, xdiss                  !: ?? 
    64  
    65    !!--------------------------------------------- 
    66    !! Damping  
    67    !!--------------------------------------------- 
    68    LOGICAL  :: ln_pisdmp 
     63   !!* Variable for chemistry of the CO2 cycle 
     64   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akb3       !: ??? 
     65   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ak13       !: ??? 
     66   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ak23       !: ??? 
     67   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   aksp       !: ??? 
     68   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akw3       !: ??? 
     69   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   borat      !: ??? 
     70   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hi         !: ??? 
    6971 
    7072#if defined key_kriest 
    71    !!--------------------------------------------------------- 
    72    !!  Kriest parameter for aggregation 
    73    !!--------------------------------------------------------- 
    74    REAL(wp) ::  xkr_eta, xkr_zeta 
    75    REAL(wp) ::  xkr_mass_min, xkr_mass_max, xkr_massp 
     73   !!*  Kriest parameter for aggregation 
     74   REAL(wp) ::   xkr_eta                            !: ??? 
     75   REAL(wp) ::   xkr_zeta                           !: ??? 
     76   REAL(wp) ::   xkr_massp                          !: ??? 
     77   REAL(wp) ::   xkr_mass_min, xkr_mass_max         !: ??? 
    7678#endif 
    7779 
    … …  
    8284#endif 
    8385    
     86   !!---------------------------------------------------------------------- 
     87   !! NEMO/TOP 3.2 , LOCEAN-IPSL (2009)  
     88   !! $Id$  
     89   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    8490   !!======================================================================    
    8591END MODULE sms_pisces     

  • trunk/NEMO/TOP_SRC/TRP/trctrp.F90

    r1271 r1445  
    128128         &                     CALL zps_hde_trc( kt, trb, gtru, gtrv )       ! tracers at the bottom ocean level 
    129129      ! 
    130       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
    131          WRITE(charout, FMT="('TRP')") 
    132          CALL prt_ctl_trc_info( charout ) 
    133          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm ) 
    134       ENDIF 
    135       ! 
    136130   END SUBROUTINE trc_trp 
    137131 

  • trunk/NEMO/TOP_SRC/oce_trc.F90

    r1329 r1445  
    180180   USE sbc_oce , ONLY :   emps       =>    emps       !: evaporation minus precipitation (kg m-2 s-2) 
    181181   USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1) 
    182    USE traqsr  , ONLY :   xsi1       =>    xsi1       !: first depth of extinction 
    183    USE traqsr  , ONLY :   ln_qsr_sms =>    ln_qsr_sms !: flag to use or not the biological fluxes for light 
     182   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface 
     183   USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction 
     184   USE traqsr  , ONLY :   rn_si2     =>    rn_si2     !: deepest depth of extinction (blue &  0.01 mg.m-3)     (RGB) 
     185   USE traqsr  , ONLY :   ln_qsr_bio =>    ln_qsr_bio !: flag to use or not the biological fluxes for light 
    184186   USE sbcrnf  , ONLY :   rnfmsk     =>    rnfmsk     !: mixed adv scheme in runoffs vicinity (hori.)  
    185187   USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.) 
Note: See TracChangeset for help on using the changeset viewer.