Changeset 2326


Ignore:
Timestamp:
2010-10-28T11:06:10+02:00 (10 years ago)
Author:
cetlod
Message:

correction of minor bugs on bio-optical retroaction when using PISCES

Location:
branches/nemo_v3_3_beta/NEMOGCM/NEMO
Files:
3 edited

Legend:

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

    r2317 r2326  
    103103      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace 
    104104      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace 
    105       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt,  ztrds 
     105      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt 
    106106      !!---------------------------------------------------------------------- 
    107107 
     
    115115      IF( l_trdtra ) THEN      ! Save ta and sa trends 
    116116         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    117          ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = 0. 
    118117      ENDIF 
    119118 
     
    143142         !                                        ! ============================================== ! 
    144143         DO jk = 1, jpkm1 
    145             DO jj = 2, jpjm1 
     144            qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
     145         END DO 
     146         !                                        Add to the general trend 
     147         DO jk = 1, jpkm1 
     148            DO jj = 2, jpjm1  
    146149               DO ji = fs_2, fs_jpim1   ! vector opt. 
    147                   qsr_hc(ji,jj,jk) =  ro0cpr * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) / fse3t(ji,jj,jk)  
     150                  z1_e3t = zfact / fse3t(ji,jj,jk) 
     151                  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 
    148152               END DO 
    149153            END DO 
     
    234238                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r ) 
    235239                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 
    236                         qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     240                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) )  
    237241                     END DO 
    238242                  END DO 
     
    251255         ENDIF 
    252256         ! 
    253       ENDIF 
    254       !                                        Add to the general trend 
    255       !                                        ************************ 
    256       DO jk = 1, nksr 
    257          DO jj = 2, jpjm1  
    258             DO ji = fs_2, fs_jpim1   ! vector opt. 
    259                z1_e3t = zfact / fse3t(ji,jj,jk) 
    260                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 
     257         !                                        Add to the general trend 
     258         DO jk = 1, nksr 
     259            DO jj = 2, jpjm1  
     260               DO ji = fs_2, fs_jpim1   ! vector opt. 
     261                  z1_e3t = zfact / fse3t(ji,jj,jk) 
     262                  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 
     263               END DO 
    261264            END DO 
    262265         END DO 
    263       END DO 
     266         ! 
     267      ENDIF 
    264268      ! 
    265269      IF( lrst_oce ) THEN   !                  Write in the ocean restart file 
     
    276280         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    277281         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt ) 
    278          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_qsr, ztrds ) 
    279          DEALLOCATE( ztrdt )    ;        DEALLOCATE( ztrds ) 
     282         DEALLOCATE( ztrdt ) 
    280283      ENDIF 
    281284      !                       ! print mean trends (used for debugging) 
     
    443446                  ! 
    444447                  DO jk = 1, nksr 
    445                      etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t_0(:,:,jk) 
     448                     etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )  
    446449                  END DO 
    447450                  etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero 
     
    471474                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r ) 
    472475                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 
    473                         etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) / fse3t_0(ji,jj,jk) 
     476                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  )  
    474477                     END DO 
    475478                  END DO 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r2317 r2326  
    168168      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient 
    169169      !! 
    170       INTEGER  ::   jchl, jband   ! dummy loop indices 
     170      INTEGER  ::   jc, jb ! dummy loop indice 
     171      INTEGER  ::   irgb   ! temporary integer 
     172      REAL(wp) ::   zchl   ! temporary scalar 
    171173      INTEGER  ::   numlight 
    172       REAL(wp) ::   zchl 
    173       !!---------------------------------------------------------------------- 
    174       ! 
    175       CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    176       DO jchl = 1, 61 
    177          READ(numlight,*) zchl, ( prgb(jband,jchl), jband=1,3 ) 
    178       END DO 
    179       CLOSE( numlight ) 
     174      !!---------------------------------------------------------------------- 
    180175      ! 
    181176      IF(lwp) THEN                         ! control print 
     
    183178         WRITE(numout,*) ' trc_oce_rgb_read : optical look-up table read in kRGB61.txt file' 
    184179         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~' 
     180         WRITE(numout,*)  
    185181      ENDIF 
     182      ! 
     183      CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
     184      DO jc = 1, 61 
     185         READ(numlight,*) zchl, ( prgb(jb,jc), jb = 1, 3 ) 
     186         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )    
     187         IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb   
     188         IF( irgb /= jc ) THEN   
     189            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb 
     190            CALL ctl_stop( 'trc_oce_rgb_read : inconsistency in Chl tabulated attenuation coeff.' ) 
     191         ENDIF 
     192      END DO 
     193      CLOSE( numlight ) 
     194      ! 
     195      r_si2 = 1.e0 / prgb(1, 1)      ! blue with the smallest chlorophyll concentration) 
     196      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2 
    186197      ! 
    187198   END SUBROUTINE trc_oce_rgb_read 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2317 r2326  
    234234      !!---------------------------------------------------------------------- 
    235235 
    236 !!      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
    237       CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients 
     236      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
     237!!      CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients 
    238238      nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01) 
    239239      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
    240240      ! 
    241       etot (:,:,:) = 0.e0 
    242       enano(:,:,:) = 0.e0 
    243       ediat(:,:,:) = 0.e0 
     241                         etot (:,:,:) = 0.e0 
     242                         enano(:,:,:) = 0.e0 
     243                         ediat(:,:,:) = 0.e0 
    244244      IF( ln_qsr_bio )   etot3(:,:,:) = 0.e0 
    245  
    246245      !  
    247246   END SUBROUTINE p4z_opt_init 
Note: See TracChangeset for help on using the changeset viewer.