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 4275 for branches – NEMO

Changeset 4275 for branches


Ignore:
Timestamp:
2013-11-20T10:28:27+01:00 (10 years ago)
Author:
cbricaud
Message:

add modifications after review in dev_r3856_MERCATOR3_QSRMEAN24H

Location:
branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r4236 r4275  
    107107      !!                  ***  FUNCTION sbc_oce_alloc  *** 
    108108      !!--------------------------------------------------------------------- 
    109       INTEGER :: ierr(4) 
     109      INTEGER :: ierr(5) 
    110110      !!--------------------------------------------------------------------- 
    111111      ierr(:) = 0 
     
    128128         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) ,                       & 
    129129         &      ssv_m  (jpi,jpj) , sss_m  (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) ) 
     130         ! 
     131         IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) ) 
    130132         ! 
    131133      sbc_oce_alloc = MAXVAL( ierr ) 
  • branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4024 r4275  
    191191 
    192192      ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery  
    193 #if defined key_top 
    194       IF( ltrcdm2dc )CALL blk_bio_meanqsr 
    195 #endif 
     193      IF( ltrcdm2dc )   CALL blk_bio_meanqsr 
    196194 
    197195#if defined key_cice 
     
    440438      !!  
    441439      !!--------------------------------------------------------------------- 
    442       INTEGER  :: ji,jj 
    443       REAL(wp) :: zfrld 
    444       !!--------------------------------------------------------------------- 
    445440      IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr') 
    446441 
     
    450445 
    451446   END SUBROUTINE blk_bio_meanqsr 
    452  
     447  
     448  
    453449   SUBROUTINE blk_ice_meanqsr(palb,p_qsr_mean,pdim) 
    454450      !!--------------------------------------------------------------------- 
     
    464460      REAL(wp) ::   zztmp         ! temporary variable 
    465461      !!--------------------------------------------------------------------- 
    466  
     462      ! 
    467463      ijpl  = pdim                            ! number of ice categories 
    468464      zztmp = 1. / ( 1. - albo ) 
     
    473469            DO ji = 1, jpi 
    474470                  p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 
    475             ENDDO 
    476          ENDDO 
    477       ENDDO 
    478  
     471            END DO 
     472         END DO 
     473      END DO 
     474      ! 
    479475   END SUBROUTINE blk_ice_meanqsr   
     476  
    480477    
    481478   SUBROUTINE blk_ice_core(  pst   , pui   , pvi   , palb ,   & 
  • branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4024 r4275  
    176176               &                      tprecip    , sprecip    ,                         & 
    177177               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    178             IF( ltrcdm2dc_ice ) &  
    179             CALL blk_ice_meanqsr(zalb_ice_cs,qsr_ice_mean,jpl  ) 
     178            IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice_cs, qsr_ice_mean, jpl ) 
    180179 
    181180         CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
  • branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r4236 r4275  
    149149# endif 
    150150 
    151    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tmp  !: save qsr with diurnal cycle during TOP/PISCES  
    152                                                                      !: timestep                [W/m2] 
    153  
    154151#else 
    155152   !!---------------------------------------------------------------------- 
  • branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r4239 r4275  
    6060      !!--------------------------------------------------------------------- 
    6161      INTEGER ::   jk, jn, jl    ! dummy loop indices 
    62       INTEGER ::   ierr 
    6362      CHARACTER (len=25) :: charout 
    6463      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace 
     
    7372      CALL top_alloc()              ! allocate TOP arrays 
    7473 
    75       IF( ln_dm2dc )THEN 
     74      IF( ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2 )THEN 
     75         ! When Diurnal cycle, core bulk and LIM2  are activated,  
     76         ! a daily mean qsr is computed for tracer/biogeochemistery model  
    7677         CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' ) 
    7778         ltrcdm2dc     = .TRUE. 
    7879         ltrcdm2dc_ice = .TRUE. 
    79          ALLOCATE( qsr_mean(jpi,jpj) , qsr_tmp(jpi,jpj) , STAT = ierr ) 
    80  
    81          IF( lk_mpp    )   CALL mpp_sum ( ierr ) 
    82          IF( ierr  > 0 )   CALL ctl_warn('trc_ini: allocation of arrays qsr_mean failed') 
    83  
     80      ELSE 
     81         CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES ' )  
    8482      ENDIF 
    8583 
  • branches/2013/dev_r3856_MERCATOR3_QSRMEAN24H/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r4239 r4275  
    5252      INTEGER               ::  jk, jn  ! dummy loop indices 
    5353      REAL(wp)              ::  ztrai 
    54       CHARACTER (len=25)    ::  charout 
     54      CHARACTER (len=25)    ::  charout  
     55 
     56      REAL(wp), DIMENSION(:,:), POINTER ::   qsr_tmp ! save qsr during TOP time-step 
    5557      !!------------------------------------------------------------------- 
    5658      ! 
     
    6769      ENDIF 
    6870      !     
    69       IF( ln_dm2dc )THEN 
     71      IF( ltrcdm2dc )THEN 
     72         ! When Diurnal cycle, core bulk and LIM2  are activated, put daily mean qsr in qsr for TOP/biogeochemistery time-step 
     73         ! and save qsr with diurnal cycle in qsr_tmp 
     74         CALL wrk_alloc( jpi,jpj, qsr_tmp ) 
    7075         qsr_tmp = qsr 
    7176         qsr     = qsr_mean     
     
    98103      ENDIF 
    99104      ! 
    100       IF( ln_dm2dc )THEN 
     105      IF( ltrcdm2dc )THEN 
     106         ! put back qsr with diurnal cycle in qsr 
    101107         qsr = qsr_tmp 
     108         CALL wrk_dealloc( jpi,jpj, qsr_tmp ) 
    102109      ENDIF 
    103110      ! 
Note: See TracChangeset for help on using the changeset viewer.