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

Changeset 3632


Ignore:
Timestamp:
2012-11-22T16:28:42+01:00 (12 years ago)
Author:
acc
Message:

Branch dev_NOC_2012_r3555. #1006. Step 9: Merge in trunk changes between revision 3385 and 3452

Location:
branches/2012/dev_NOC_2012_rev3555/NEMOGCM
Files:
23 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces

    r3294 r3632  
    1616!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    1717   ln_co2int  =  .false. ! read atm pco2 from a file (T) or constant (F) 
    18    atcco2     =  287.    ! Constant value atmospheric pCO2 - ln_co2int = F 
     18   atcco2     =  280.    ! Constant value atmospheric pCO2 - ln_co2int = F 
    1919   clname     =  'atcco2.txt'  ! Name of atm pCO2 file - ln_co2int = T 
    2020   nn_offset  =  0       ! Offset model-data start year - ln_co2int = T 
     
    3535&nampisbio     !   biological parameters 
    3636!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    37    nrdttrc    =  1        ! time step frequency for biology 
     37   nrdttrc    =  4        ! time step frequency for biology 
    3838   wsbio      =  2.       ! POC sinking speed 
    39    xkmort     =  1.E-7    ! half saturation constant for mortality 
     39   xkmort     =  2.E-7    ! half saturation constant for mortality 
    4040   ferat3     =  10.E-6   ! Fe/C in zooplankton  
    4141   wsbio2     =  30.      ! Big particles sinking speed 
     
    4444&nampislim     !   parameters for nutrient limitations 
    4545!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    46    conc0      =  2.e-6    ! Phosphate half saturation 
     46   conc0      =  1.e-6    ! Phosphate half saturation 
    4747   conc1      =  8E-6     ! Phosphate half saturation for diatoms 
    48    conc2      =  2E-9     ! Iron half saturation for phyto 
    49    conc2m     =  4E-9     ! Max iron half saturation for phyto 
     48   conc2      =  1E-9     ! Iron half saturation for phyto 
     49   conc2m     =  3E-9     ! Max iron half saturation for phyto 
    5050   conc3      =  3E-9     ! Iron half saturation for diatoms 
    51    conc3m     =  9E-9     ! Maxi iron half saturation for diatoms 
    52    xsizedia   =  5.E-7    ! Minimum size criteria for diatoms 
     51   conc3m     =  8E-9     ! Maxi iron half saturation for diatoms 
     52   xsizedia   =  1.E-6    ! Minimum size criteria for diatoms 
    5353   xsizephy   =  1.E-6    ! Minimum size criteria for phyto 
    5454   concnnh4   =  1.E-7    ! NH4 half saturation for phyto 
    55    concdnh4   =  4.E-7    ! NH4 half saturation for diatoms 
     55   concdnh4   =  8.E-7    ! NH4 half saturation for diatoms 
    5656   xksi1      =  2.E-6    ! half saturation constant for Si uptake 
    5757   xksi2      =  3.33E-6  ! half saturation constant for Si/C 
    5858   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization 
    59    concfebac  =  3.E-11   ! Half-saturation for Fe limitation of Bacteria 
     59   concfebac  =  1.E-11   ! Half-saturation for Fe limitation of Bacteria 
    6060   qnfelim    =  7.E-6    ! Optimal quota of phyto 
    6161   qdfelim    =  7.E-6    ! Optimal quota of diatoms 
     
    6565&nampisprod     !   parameters for phytoplankton growth 
    6666!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    67    pislope    =  3.       ! P-I slope 
     67   pislope    =  2.       ! P-I slope 
    6868   pislope2   =  2.       ! P-I slope  for diatoms 
    6969   excret     =  0.05     ! excretion ratio of phytoplankton 
    7070   excret2    =  0.05     ! excretion ratio of diatoms 
    71    ln_newprod =  .false.  ! Enable new parame. of production (T/F)  
     71   ln_newprod =  .true.  ! Enable new parame. of production (T/F)  
    7272   bresp      =  0.00333  ! Basal respiration rate 
    7373   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton 
    74    chlcdm     =  0.04     ! Minimum Chl/C in diatoms 
     74   chlcdm     =  0.05     ! Minimum Chl/C in diatoms 
    7575   chlcmin    =  0.0033   ! Maximum Chl/c in phytoplankton 
    7676   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton 
     
    100100   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton  
    101101   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton  
    102    xthresh2phy = 2E-7     ! nanophyto feeding threshold for mesozooplankton  
     102   xthresh2phy = 1E-8     ! nanophyto feeding threshold for mesozooplankton  
    103103   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton  
    104    xthresh2   =  0.       ! Food threshold for grazing 
     104   xthresh2   =  2E-7    ! Food threshold for grazing 
    105105   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing 
    106    epsher2    =  0.33     ! Efficicency of Mesozoo growth 
     106   epsher2    =  0.3      ! Efficicency of Mesozoo growth 
    107107   sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM 
    108108   unass2     =  0.3      ! non assimilated fraction of P by mesozoo 
    109    grazflux   =  3.e3     ! flux-feeding rate 
     109   grazflux   =  2.e3     ! flux-feeding rate 
    110110/ 
    111111!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     
    115115   grazrat    =  3.0      ! maximal zoo grazing rate 
    116116   resrat     =  0.03     ! exsudation rate of zooplankton 
    117    mzrat      =  0.0      ! zooplankton mortality rate 
     117   mzrat      =  0.001    ! zooplankton mortality rate 
    118118   xpref2c    =  0.1      ! Microzoo preference for POM 
    119119   xpref2p    =  1.       ! Microzoo preference for Nanophyto 
    120    xpref2d    =  0.6      ! Microzoo preference for Diatoms 
     120   xpref2d    =  0.5      ! Microzoo preference for Diatoms 
    121121   xthreshdia =  1.E-8    ! Diatoms feeding threshold for microzooplankton  
    122    xthreshphy =  2.E-7    ! Nanophyto feeding threshold for microzooplankton  
     122   xthreshphy =  1.E-8    ! Nanophyto feeding threshold for microzooplankton  
    123123   xthreshpoc =  1.E-8    ! POC feeding threshold for microzooplankton  
    124    xthresh    =  0.       ! Food threshold for feeding 
     124   xthresh    =  2.E-7    ! Food threshold for feeding 
    125125   xkgraz     =  20.E-6   ! half sturation constant for grazing 
    126    epsher     =  0.33     ! Efficiency of microzoo growth 
     126   epsher     =  0.3      ! Efficiency of microzoo growth 
    127127   sigma1     =  0.6      ! Fraction of microzoo excretion as DOM 
    128128   unass      =  0.3      ! non assimilated fraction of phyto by zoo 
     
    160160   cn_dir      = './'      !  root directory for the location of the dynamical files 
    161161   ln_dust     =  .true.   ! boolean for dust input from the atmosphere 
    162    ln_river    =  .true.   ! boolean for river input of nutrients 
     162   ln_river    =  .false.   ! boolean for river input of nutrients 
    163163   ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N 
    164164   ln_ironsed  =  .true.   ! boolean for Fe input from sediments 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces

    r3294 r3632  
    1616!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    1717   ln_co2int  =  .false. ! read atm pco2 from a file (T) or constant (F) 
    18    atcco2     =  287.    ! Constant value atmospheric pCO2 - ln_co2int = F 
     18   atcco2     =  280.    ! Constant value atmospheric pCO2 - ln_co2int = F 
    1919   clname     =  'atcco2.txt'  ! Name of atm pCO2 file - ln_co2int = T 
    2020   nn_offset  =  0       ! Offset model-data start year - ln_co2int = T 
     
    3737   nrdttrc    =  4        ! time step frequency for biology 
    3838   wsbio      =  2.       ! POC sinking speed 
    39    xkmort     =  1.E-7    ! half saturation constant for mortality 
     39   xkmort     =  2.E-7    ! half saturation constant for mortality 
    4040   ferat3     =  10.E-6   ! Fe/C in zooplankton  
    4141   wsbio2     =  30.      ! Big particles sinking speed 
     
    4444&nampislim     !   parameters for nutrient limitations 
    4545!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    46    conc0      =  2.e-6    ! Phosphate half saturation 
     46   conc0      =  1.e-6    ! Phosphate half saturation 
    4747   conc1      =  8E-6     ! Phosphate half saturation for diatoms 
    48    conc2      =  2E-9     ! Iron half saturation for phyto 
    49    conc2m     =  4E-9     ! Max iron half saturation for phyto 
     48   conc2      =  1E-9     ! Iron half saturation for phyto 
     49   conc2m     =  3E-9     ! Max iron half saturation for phyto 
    5050   conc3      =  3E-9     ! Iron half saturation for diatoms 
    51    conc3m     =  9E-9     ! Maxi iron half saturation for diatoms 
    52    xsizedia   =  5.E-7    ! Minimum size criteria for diatoms 
     51   conc3m     =  8E-9     ! Maxi iron half saturation for diatoms 
     52   xsizedia   =  1.E-6    ! Minimum size criteria for diatoms 
    5353   xsizephy   =  1.E-6    ! Minimum size criteria for phyto 
    5454   concnnh4   =  1.E-7    ! NH4 half saturation for phyto 
    55    concdnh4   =  4.E-7    ! NH4 half saturation for diatoms 
     55   concdnh4   =  8.E-7    ! NH4 half saturation for diatoms 
    5656   xksi1      =  2.E-6    ! half saturation constant for Si uptake 
    5757   xksi2      =  3.33E-6  ! half saturation constant for Si/C 
    5858   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization 
    59    concfebac  =  3.E-11   ! Half-saturation for Fe limitation of Bacteria 
     59   concfebac  =  1.E-11   ! Half-saturation for Fe limitation of Bacteria 
    6060   qnfelim    =  7.E-6    ! Optimal quota of phyto 
    6161   qdfelim    =  7.E-6    ! Optimal quota of diatoms 
     
    6565&nampisprod     !   parameters for phytoplankton growth 
    6666!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    67    pislope    =  3.       ! P-I slope 
     67   pislope    =  2.       ! P-I slope 
    6868   pislope2   =  2.       ! P-I slope  for diatoms 
    6969   excret     =  0.05     ! excretion ratio of phytoplankton 
    7070   excret2    =  0.05     ! excretion ratio of diatoms 
    71    ln_newprod =  .false.  ! Enable new parame. of production (T/F)  
     71   ln_newprod =  .true.  ! Enable new parame. of production (T/F)  
    7272   bresp      =  0.00333  ! Basal respiration rate 
    7373   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton 
    74    chlcdm     =  0.04     ! Minimum Chl/C in diatoms 
     74   chlcdm     =  0.05     ! Minimum Chl/C in diatoms 
    7575   chlcmin    =  0.0033   ! Maximum Chl/c in phytoplankton 
    7676   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton 
     
    100100   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton  
    101101   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton  
    102    xthresh2phy = 2E-7     ! nanophyto feeding threshold for mesozooplankton  
     102   xthresh2phy = 1E-8     ! nanophyto feeding threshold for mesozooplankton  
    103103   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton  
    104    xthresh2   =  0.       ! Food threshold for grazing 
     104   xthresh2   =  2E-7    ! Food threshold for grazing 
    105105   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing 
    106    epsher2    =  0.33     ! Efficicency of Mesozoo growth 
     106   epsher2    =  0.3      ! Efficicency of Mesozoo growth 
    107107   sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM 
    108108   unass2     =  0.3      ! non assimilated fraction of P by mesozoo 
    109    grazflux   =  3.e3     ! flux-feeding rate 
     109   grazflux   =  2.e3     ! flux-feeding rate 
    110110/ 
    111111!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     
    115115   grazrat    =  3.0      ! maximal zoo grazing rate 
    116116   resrat     =  0.03     ! exsudation rate of zooplankton 
    117    mzrat      =  0.0      ! zooplankton mortality rate 
     117   mzrat      =  0.001    ! zooplankton mortality rate 
    118118   xpref2c    =  0.1      ! Microzoo preference for POM 
    119119   xpref2p    =  1.       ! Microzoo preference for Nanophyto 
    120    xpref2d    =  0.6      ! Microzoo preference for Diatoms 
     120   xpref2d    =  0.5      ! Microzoo preference for Diatoms 
    121121   xthreshdia =  1.E-8    ! Diatoms feeding threshold for microzooplankton  
    122    xthreshphy =  2.E-7    ! Nanophyto feeding threshold for microzooplankton  
     122   xthreshphy =  1.E-8    ! Nanophyto feeding threshold for microzooplankton  
    123123   xthreshpoc =  1.E-8    ! POC feeding threshold for microzooplankton  
    124    xthresh    =  0.       ! Food threshold for feeding 
     124   xthresh    =  2.E-7    ! Food threshold for feeding 
    125125   xkgraz     =  20.E-6   ! half sturation constant for grazing 
    126    epsher     =  0.33     ! Efficiency of microzoo growth 
     126   epsher     =  0.3      ! Efficiency of microzoo growth 
    127127   sigma1     =  0.6      ! Fraction of microzoo excretion as DOM 
    128128   unass      =  0.3      ! non assimilated fraction of phyto by zoo 
     
    160160   cn_dir      = './'      !  root directory for the location of the dynamical files 
    161161   ln_dust     =  .true.   ! boolean for dust input from the atmosphere 
    162    ln_river    =  .true.   ! boolean for river input of nutrients 
     162   ln_river    =  .false.   ! boolean for river input of nutrients 
    163163   ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N 
    164164   ln_ironsed  =  .true.   ! boolean for Fe input from sediments 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OFF_SRC/domain.F90

    r2574 r3632  
    205205      rdtmax    = rn_rdtmin 
    206206      rdth      = rn_rdth 
    207       nclosea   = nn_closea 
    208207 
    209208      REWIND( numnam )             ! Namelist cross land advection 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r3298 r3632  
    773773            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    774774               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    775                nbj => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     775               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    776776               flagu => idx_bdy(ib_bdy)%flagu(ib) 
    777777               bdysurftot = bdysurftot + hu     (nbi  , nbj)                           & 
     
    786786            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    787787               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    788                nbj => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     788               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    789789               flagv => idx_bdy(ib_bdy)%flagv(ib) 
    790790               bdysurftot = bdysurftot + hv     (nbi, nbj  )                           & 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r3294 r3632  
    3838  USE dianam          ! build name of file 
    3939  USE lib_mpp         ! distributed memory computing library 
    40 #if defined key_lim2 || defined key_lim3 
    41   USE ice 
     40#if defined key_lim2 
     41  USE ice_2 
     42#endif 
     43#if defined key_lim3 
     44  USE ice_3 
    4245#endif 
    4346  USE domvvl 
     
    362365              WRITE(numout,*)"      List of points in global domain:" 
    363366              DO jpt=1,iptglo 
    364                  WRITE(numout,*)'        # I J ',jpt,coordtemp(jpt) 
     367                 WRITE(numout,*)'        # I J ',jpt,coordtemp(jpt),directemp(jpt) 
    365368              ENDDO                   
    366369           ENDIF 
     
    403406 
    404407              IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 
    405               WRITE(narea+200,*)'avant secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc 
    406408              DO jpt = 1,iptloc 
    407409                 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 
    408410                 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 
    409                  WRITE(narea+200,*)'avant # I J : ',iiglo,ijglo 
    410411              ENDDO 
    411412              ENDIF 
     
    421422           ENDIF 
    422423           IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 
    423               WRITE(narea+200,*)'apres secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc 
    424424              DO jpt = 1,secs(jsec)%nb_point 
    425425                 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 
    426426                 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 
    427                  WRITE(narea+200,*)'apres # I J : ',iiglo,ijglo 
    428427              ENDDO 
    429428           ENDIF 
     
    626625        ELSE                                ; isgnv =  1 
    627626        ENDIF 
    628  
    629         IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv 
     627        IF( sec%slopeSection .GE. 9999. )     isgnv =  1 
     628 
     629        IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,isgnu,isgnv 
    630630 
    631631        !--------------------------------------! 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r3625 r3632  
    175175         z3d(:,:,jpk) = 0.e0 
    176176         DO jk = 1, jpkm1 
    177             z3d(:,:,jk) = rau0 * un(:,:,jk) * e1u(:,:) * fse3u(:,:,jk) 
     177            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 
    178178         END DO 
    179179         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     
    190190         CALL iom_put( "u_heattr", z2d )                  ! heat transport in i-direction 
    191191         DO jk = 1, jpkm1 
    192             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e2v(:,:) * fse3v(:,:,jk) 
     192            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 
    193193         END DO 
    194194         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r3625 r3632  
    77   !!             8.5  !  02-06  (E. Durand, G. Madec)  F90 
    88   !!             9.0  !  06-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat 
     9   !!        NEMO 3.4  !  03-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility 
    910   !!---------------------------------------------------------------------- 
    1011 
     
    1819   USE oce             ! dynamics and tracers 
    1920   USE dom_oce         ! ocean space and time domain 
    20    USE phycst 
     21   USE phycst          ! physical constants 
    2122   USE in_out_manager  ! I/O manager 
    2223   USE sbc_oce         ! ocean surface boundary conditions 
    23    USE lib_mpp         ! distributed memory computing library 
    24    USE lbclnk          ! ??? 
     24   USE lib_fortran,    ONLY: glob_sum, DDPDD 
     25   USE lbclnk          ! lateral boundary condition - MPP exchanges 
     26   USE lib_mpp         ! MPP library 
     27   USE timing 
    2528 
    2629   IMPLICIT NONE 
     
    8689         SELECT CASE ( jp_cfg ) 
    8790         !                                           ! ======================= 
     91         CASE ( 1 )                                  ! ORCA_R1 configuration 
     92            !                                        ! ======================= 
     93            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea 
     94            ncsi1(1)   = 332  ; ncsj1(1)   = 203 
     95            ncsi2(1)   = 344  ; ncsj2(1)   = 235 
     96            ncsir(1,1) = 1    ; ncsjr(1,1) = 1 
     97            !                                         
     98            !                                        ! ======================= 
    8899         CASE ( 2 )                                  !  ORCA_R2 configuration 
    89100            !                                        ! ======================= 
     
    174185      !!      put as run-off in open ocean. 
    175186      !! 
    176       !! ** Action  :   emp   updated surface freshwater flux at kt 
     187      !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt 
    177188      !!---------------------------------------------------------------------- 
    178189      INTEGER, INTENT(in) ::   kt   ! ocean model time step 
    179190      ! 
    180       INTEGER                     ::   ji, jj, jc, jn   ! dummy loop indices 
    181       REAL(wp)                    ::   zze2, zcoef, zcoef1 
    182       REAL(wp), DIMENSION (jpncs) ::   zfwf  
    183       !!---------------------------------------------------------------------- 
    184       ! 
     191      INTEGER             ::   ji, jj, jc, jn   ! dummy loop indices 
     192      REAL(wp), PARAMETER ::   rsmall = 1.e-20_wp    ! Closed sea correction epsilon 
     193      REAL(wp)            ::   zze2, ztmp, zcorr     !  
     194      REAL(wp)            ::   zcoef, zcoef1         !  
     195      COMPLEX(wp)         ::   ctmp  
     196      REAL(wp), DIMENSION(jpncs) ::   zfwf   ! 1D workspace 
     197      !!---------------------------------------------------------------------- 
     198      ! 
     199      IF( nn_timing == 1 )  CALL timing_start('sbc_clo') 
    185200      !                                                   !------------------! 
    186201      IF( kt == nit000 ) THEN                             !  Initialisation  ! 
     
    190205         IF(lwp) WRITE(numout,*)'~~~~~~~' 
    191206 
    192          ! Total surface of ocean 
    193          surf(jpncs+1) = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    194  
    195          DO jc = 1, jpncs 
    196             surf(jc) =0.e0 
    197             DO jj = ncsj1(jc), ncsj2(jc) 
    198                DO ji = ncsi1(jc), ncsi2(jc) 
    199                   surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas 
     207         surf(:) = 0.e0_wp 
     208         ! 
     209         surf(jpncs+1) = glob_sum( e1e2t(:,:) )   ! surface of the global ocean 
     210         ! 
     211         !                                        ! surface of closed seas  
     212         IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation 
     213            DO jc = 1, jpncs 
     214               ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     215               DO jj = ncsj1(jc), ncsj2(jc) 
     216                  DO ji = ncsi1(jc), ncsi2(jc) 
     217                     ztmp = e1e2t(ji,jj) * tmask_i(ji,jj) 
     218                     CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     219                  END DO  
    200220               END DO  
    201             END DO  
    202          END DO  
    203          IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain 
     221               IF( lk_mpp )   CALL mpp_sum( ctmp ) 
     222               surf(jc) = REAL(ctmp,wp) 
     223            END DO 
     224         ELSE                                          ! Standard calculation            
     225            DO jc = 1, jpncs 
     226               DO jj = ncsj1(jc), ncsj2(jc) 
     227                  DO ji = ncsi1(jc), ncsi2(jc) 
     228                     surf(jc) = surf(jc) + e1e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas 
     229                  END DO  
     230               END DO  
     231            END DO  
     232            IF( lk_mpp )   CALL mpp_sum ( surf, jpncs )       ! mpp: sum over all the global domain 
     233         ENDIF 
    204234 
    205235         IF(lwp) WRITE(numout,*)'     Closed sea surfaces' 
     
    216246      !                                                   !--------------------! 
    217247      !                                                   !  update emp        ! 
    218       zfwf = 0.e0                                         !--------------------! 
    219       DO jc = 1, jpncs 
    220          DO jj = ncsj1(jc), ncsj2(jc) 
    221             DO ji = ncsi1(jc), ncsi2(jc) 
    222                zfwf(jc) = zfwf(jc) + e1t(ji,jj) * e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj)  
    223             END DO   
    224          END DO  
    225       END DO 
    226       IF( lk_mpp )   CALL mpp_sum ( zfwf(:) , jpncs )       ! mpp: sum over all the global domain 
     248      zfwf = 0.e0_wp                                      !--------------------! 
     249      IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation 
     250         DO jc = 1, jpncs 
     251            ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     252            DO jj = ncsj1(jc), ncsj2(jc) 
     253               DO ji = ncsi1(jc), ncsi2(jc) 
     254                  ztmp = e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 
     255                  CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     256               END DO   
     257            END DO  
     258            IF( lk_mpp )   CALL mpp_sum( ctmp ) 
     259            zfwf(jc) = REAL(ctmp,wp) 
     260         END DO 
     261      ELSE                                          ! Standard calculation            
     262         DO jc = 1, jpncs 
     263            DO jj = ncsj1(jc), ncsj2(jc) 
     264               DO ji = ncsi1(jc), ncsi2(jc) 
     265                  zfwf(jc) = zfwf(jc) + e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj)  
     266               END DO   
     267            END DO  
     268         END DO 
     269         IF( lk_mpp )   CALL mpp_sum ( zfwf(:) , jpncs )       ! mpp: sum over all the global domain 
     270      ENDIF 
    227271 
    228272      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration 
    229          zze2    = ( zfwf(3) + zfwf(4) ) / 2. 
     273         zze2    = ( zfwf(3) + zfwf(4) ) * 0.5_wp 
    230274         zfwf(3) = zze2 
    231275         zfwf(4) = zze2 
    232276      ENDIF 
    233277 
     278      zcorr = 0._wp 
     279 
    234280      DO jc = 1, jpncs 
    235281         ! 
    236          IF( ncstt(jc) == 0 ) THEN  
    237             ! water/evap excess is shared by all open ocean 
    238             zcoef  = zfwf(jc) / surf(jpncs+1) 
    239             zcoef1 = rcp * zcoef 
    240             emp(:,:) = emp(:,:) + zcoef 
    241             qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
    242          ELSEIF( ncstt(jc) == 1 ) THEN  
    243             ! Excess water in open sea, at outflow location, excess evap shared 
    244             IF ( zfwf(jc) <= 0.e0 ) THEN  
    245                 DO jn = 1, ncsnr(jc) 
     282         ! The following if avoids the redistribution of the round off 
     283         IF ( ABS(zfwf(jc) / surf(jpncs+1) ) > rsmall) THEN 
     284            ! 
     285            IF( ncstt(jc) == 0 ) THEN           ! water/evap excess is shared by all open ocean 
     286               zcoef    = zfwf(jc) / surf(jpncs+1) 
     287               zcoef1   = rcp * zcoef 
     288               emp(:,:) = emp(:,:) + zcoef 
     289               qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
     290               ! accumulate closed seas correction 
     291               zcorr    = zcorr    + zcoef 
     292               ! 
     293            ELSEIF( ncstt(jc) == 1 ) THEN       ! Excess water in open sea, at outflow location, excess evap shared 
     294               IF ( zfwf(jc) <= 0.e0_wp ) THEN  
     295                   DO jn = 1, ncsnr(jc) 
     296                     ji = mi0(ncsir(jc,jn)) 
     297                     jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 
     298                     IF (      ji > 1 .AND. ji < jpi   & 
     299                         .AND. jj > 1 .AND. jj < jpj ) THEN  
     300                         zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) ) 
     301                         zcoef1     = rcp * zcoef 
     302                         emp(ji,jj) = emp(ji,jj) + zcoef 
     303                         qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 
     304                     ENDIF  
     305                   END DO  
     306               ELSE  
     307                   zcoef    = zfwf(jc) / surf(jpncs+1) 
     308                   zcoef1   = rcp * zcoef 
     309                   emp(:,:) = emp(:,:) + zcoef 
     310                   qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
     311                   ! accumulate closed seas correction 
     312                   zcorr    = zcorr    + zcoef 
     313               ENDIF 
     314            ELSEIF( ncstt(jc) == 2 ) THEN       ! Excess e-p-r (either sign) goes to open ocean, at outflow location 
     315               DO jn = 1, ncsnr(jc) 
    246316                  ji = mi0(ncsir(jc,jn)) 
    247317                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 
    248                   IF (      ji > 1 .AND. ji < jpi   & 
    249                       .AND. jj > 1 .AND. jj < jpj ) THEN  
    250                       zcoef  = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) ) 
    251                       zcoef1 = rcp * zcoef 
    252                       emp(ji,jj) = emp(ji,jj) + zcoef 
    253                       qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 
    254                   END IF  
    255                 END DO  
    256             ELSE  
    257                 zcoef  = zfwf(jc) / surf(jpncs+1) 
    258                 zcoef1 = rcp * zcoef 
    259                 emp(:,:) = emp(:,:) + zcoef 
    260                 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
    261             ENDIF 
    262          ELSEIF( ncstt(jc) == 2 ) THEN  
    263             ! Excess e-p+r (either sign) goes to open ocean, at outflow location 
    264             IF(      ji > 1 .AND. ji < jpi    & 
    265                .AND. jj > 1 .AND. jj < jpj ) THEN  
    266                 DO jn = 1, ncsnr(jc) 
    267                   ji = mi0(ncsir(jc,jn)) 
    268                   jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 
    269                   zcoef  = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) ) 
    270                   zcoef1 = rcp * zcoef 
    271                   emp(ji,jj) = emp(ji,jj) + zcoef 
    272                   qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 
    273                 END DO  
     318                  IF(      ji > 1 .AND. ji < jpi    & 
     319                     .AND. jj > 1 .AND. jj < jpj ) THEN  
     320                     zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) *  e1e2t(ji,jj) ) 
     321                     zcoef1     = rcp * zcoef 
     322                     emp(ji,jj) = emp(ji,jj) + zcoef 
     323                     qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 
     324                  ENDIF  
     325               END DO  
    274326            ENDIF  
    275          ENDIF  
    276          ! 
    277          DO jj = ncsj1(jc), ncsj2(jc) 
    278             DO ji = ncsi1(jc), ncsi2(jc) 
    279                zcoef  = zfwf(jc) / surf(jc) 
    280                zcoef1 = rcp * zcoef 
    281                emp(ji,jj) = emp(ji,jj) - zcoef 
    282                qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj) 
    283             END DO   
    284          END DO  
    285          ! 
     327            ! 
     328            DO jj = ncsj1(jc), ncsj2(jc) 
     329               DO ji = ncsi1(jc), ncsi2(jc) 
     330                  zcoef      = zfwf(jc) / surf(jc) 
     331                  zcoef1     = rcp * zcoef 
     332                  emp(ji,jj) = emp(ji,jj) - zcoef 
     333                  qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj) 
     334               END DO   
     335            END DO  
     336            ! 
     337         END IF 
    286338      END DO  
    287       ! 
    288       CALL lbc_lnk( emp , 'T', 1. ) 
     339 
     340      IF ( ABS(zcorr) > rsmall ) THEN      ! remove the global correction from the closed seas 
     341         DO jc = 1, jpncs                  ! only if it is large enough 
     342            DO jj = ncsj1(jc), ncsj2(jc) 
     343               DO ji = ncsi1(jc), ncsi2(jc) 
     344                  emp(ji,jj) = emp(ji,jj) - zcorr 
     345                  qns(ji,jj) = qns(ji,jj) + rcp * zcorr * sst_m(ji,jj) 
     346               END DO   
     347             END DO  
     348          END DO 
     349      ENDIF 
     350      ! 
     351      emp (:,:) = emp (:,:) * tmask(:,:,1) 
     352      ! 
     353      CALL lbc_lnk( emp , 'T', 1._wp ) 
     354      ! 
     355      IF( nn_timing == 1 )  CALL timing_stop('sbc_clo') 
    289356      ! 
    290357   END SUBROUTINE sbc_clo 
    291     
    292     
     358 
     359 
    293360   SUBROUTINE clo_rnf( p_rnfmsk ) 
    294361      !!--------------------------------------------------------------------- 
     
    314381               ii = mi0( ncsir(jc,jn) ) 
    315382               ij = mj0( ncsjr(jc,jn) ) 
    316                p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 ) 
     383               p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0_wp ) 
    317384            END DO  
    318385         ENDIF  
     
    342409         DO jj = ncsj1(jc), ncsj2(jc) 
    343410            DO ji = ncsi1(jc), ncsi2(jc) 
    344                p_upsmsk(ji,jj) = 0.5            ! mixed upstream/centered scheme over closed seas 
     411               p_upsmsk(ji,jj) = 0.5_wp         ! mixed upstream/centered scheme over closed seas 
    345412            END DO  
    346413         END DO  
     
    380447   !!====================================================================== 
    381448END MODULE closea 
     449 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r3294 r3632  
    5252   REAL(wp), PUBLIC ::   rdtmax          !: maximum time step on tracers 
    5353   REAL(wp), PUBLIC ::   rdth            !: depth variation of tracer step 
    54    INTEGER , PUBLIC ::   nclosea         !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 
    5554 
    5655   !                                                  !!! associated variables 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r3294 r3632  
    238238      rdtmax    = rn_rdtmin 
    239239      rdth      = rn_rdth 
    240       nclosea   = nn_closea 
    241240 
    242241      REWIND( numnam )              ! Namelist cross land advection 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r3294 r3632  
    422422            CALL iom_close( inum ) 
    423423            mbathy(:,:) = INT( bathy(:,:) ) 
    424             !                                                ! ===================== 
     424            ! 
    425425            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    426                !                                             ! ===================== 
     426               ! 
    427427               IF( nn_cla == 0 ) THEN 
    428428                  ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open  
     
    454454            CALL iom_get  ( inum, jpdom_data, 'Bathymetry', bathy ) 
    455455            CALL iom_close( inum ) 
    456             !                                                ! ===================== 
     456            !                                                 
    457457            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    458                !                                             ! ===================== 
     458               ! 
    459459              IF( nn_cla == 0 ) THEN 
    460460                 ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open  
     
    489489      ENDIF 
    490490      ! 
    491       !                                               ! =========================== ! 
    492       IF( nclosea == 0 ) THEN                         !   NO closed seas or lakes   ! 
    493          DO jl = 1, jpncs                             ! =========================== ! 
    494             DO jj = ncsj1(jl), ncsj2(jl) 
    495                DO ji = ncsi1(jl), ncsi2(jl) 
    496                   mbathy(ji,jj) = 0                   ! suppress closed seas and lakes from bathymetry 
    497                   bathy (ji,jj) = 0._wp                
    498                END DO 
    499             END DO 
    500          END DO 
    501       ENDIF 
    502       ! 
    503       !                                               ! =========================== ! 
    504       !                                               !     set a minimum depth     ! 
    505       !                                               ! =========================== ! 
    506       IF ( .not. ln_sco ) THEN 
     491      IF( nn_closea == 0 )   CALL clo_bat( bathy, mbathy )    !==  NO closed seas or lakes  ==! 
     492      !                        
     493      IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==! 
    507494         IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level 
    508495         ELSE                          ;   ik = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r3294 r3632  
    678678      REAL(wp) :: zrhdt1  
    679679      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 
    680       INTEGER  :: zbhitwe, zbhitns 
    681       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdeptht, zrhh  
     680      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh  
    682681      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
    683682      !!---------------------------------------------------------------------- 
    684683      ! 
    685684      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )  
    686       CALL wrk_alloc( jpi,jpj,jpk, zdeptht, zrhh )  
     685      CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh )  
    687686      ! 
    688687      IF( kt == nit000 ) THEN 
     
    717716      END DO 
    718717 
    719       ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdeptht(:,:,:)" 
    720       DO jj = 1, jpj 
    721         DO ji = 1, jpi 
    722           zdeptht(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) 
    723           zdeptht(ji,jj,1) = zdeptht(ji,jj,1) - sshn(ji,jj) * znad 
    724           DO jk = 2, jpk 
    725              zdeptht(ji,jj,jk) = zdeptht(ji,jj,jk-1) + fse3w(ji,jj,jk) 
    726           END DO 
    727         END DO 
    728       END DO 
    729  
    730       DO jk = 1, jpkm1 
    731         DO jj = 1, jpj 
    732           DO ji = 1, jpi 
    733             fsp(ji,jj,jk) = zrhh(ji,jj,jk) 
    734             xsp(ji,jj,jk) = zdeptht(ji,jj,jk) 
    735           END DO 
    736         END DO 
    737       END DO 
     718      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 
     719      DO jj = 1, jpj;   DO ji = 1, jpi 
     720          zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 
     721      END DO        ;   END DO 
     722 
     723      DO jk = 2, jpk;   DO jj = 1, jpj;   DO ji = 1, jpi 
     724          zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 
     725      END DO        ;   END DO        ;   END DO 
     726 
     727      fsp(:,:,:) = zrhh(:,:,:) 
     728      xsp(:,:,:) = zdept(:,:,:) 
    738729 
    739730      ! Construct the vertical density profile with the  
     
    745736      DO jj = 2, jpj 
    746737        DO ji = 2, jpi  
    747           zrhdt1 = zrhh(ji,jj,1) - interp3(zdeptht(ji,jj,1),asp(ji,jj,1), & 
     738          zrhdt1 = zrhh(ji,jj,1) - interp3(zdept(ji,jj,1),asp(ji,jj,1), & 
    748739                                         bsp(ji,jj,1),   csp(ji,jj,1), & 
    749                                          dsp(ji,jj,1) ) * 0.5_wp * zdeptht(ji,jj,1) 
    750           zrhdt1 = MAX(zrhdt1, 1000._wp - rau0)        ! no lighter than fresh water 
     740                                         dsp(ji,jj,1) ) * 0.25_wp * fse3w(ji,jj,1) 
    751741 
    752742          ! assuming linear profile across the top half surface layer 
     
    760750          DO ji = 2, jpi 
    761751            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                          & 
    762                              integ2(zdeptht(ji,jj,jk-1), zdeptht(ji,jj,jk),& 
     752                             integ_spline(zdept(ji,jj,jk-1), zdept(ji,jj,jk),& 
    763753                                    asp(ji,jj,jk-1),    bsp(ji,jj,jk-1), & 
    764754                                    csp(ji,jj,jk-1),    dsp(ji,jj,jk-1)) 
     
    793783      END DO 
    794784 
     785      DO jk = 1, jpkm1 
     786        DO jj = 2, jpjm1 
     787          DO ji = 2, jpim1 
     788            zu(ji,jj,jk) = min(zu(ji,jj,jk), max(-zdept(ji,jj,jk), -zdept(ji+1,jj,jk))) 
     789            zu(ji,jj,jk) = max(zu(ji,jj,jk), min(-zdept(ji,jj,jk), -zdept(ji+1,jj,jk))) 
     790            zv(ji,jj,jk) = min(zv(ji,jj,jk), max(-zdept(ji,jj,jk), -zdept(ji,jj+1,jk))) 
     791            zv(ji,jj,jk) = max(zv(ji,jj,jk), min(-zdept(ji,jj,jk), -zdept(ji,jj+1,jk))) 
     792          END DO 
     793        END DO 
     794      END DO 
     795 
     796 
    795797      DO jk = 1, jpkm1                                   
    796798        DO jj = 2, jpjm1      
     
    803805            !!!!!     for u equation 
    804806            IF( jk <= mbku(ji,jj) ) THEN 
    805                IF( -zdeptht(ji+1,jj,mbku(ji,jj)) >= -zdeptht(ji,jj,mbku(ji,jj)) ) THEN 
     807               IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 
    806808                 jis = ji + 1; jid = ji 
    807809               ELSE 
     
    811813               ! integrate the pressure on the shallow side 
    812814               jk1 = jk  
    813                zbhitwe = 0 
    814                DO WHILE ( -zdeptht(jis,jj,jk1) > zuijk ) 
     815               DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 
    815816                 IF( jk1 == mbku(ji,jj) ) THEN 
    816                    zbhitwe = 1 
     817                   zuijk = -zdept(jis,jj,jk1) 
    817818                   EXIT 
    818819                 ENDIF 
    819                  zdeps = MIN(zdeptht(jis,jj,jk1+1), -zuijk) 
     820                 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 
    820821                 zpwes = zpwes +                                    &  
    821                       integ2(zdeptht(jis,jj,jk1), zdeps,            & 
     822                      integ_spline(zdept(jis,jj,jk1), zdeps,            & 
    822823                             asp(jis,jj,jk1),    bsp(jis,jj,jk1), & 
    823824                             csp(jis,jj,jk1),    dsp(jis,jj,jk1)) 
     
    825826               END DO 
    826827             
    827                IF(zbhitwe == 1) THEN 
    828                  zuijk = -zdeptht(jis,jj,jk1) 
    829                ENDIF 
    830  
    831828               ! integrate the pressure on the deep side 
    832829               jk1 = jk  
    833                zbhitwe = 0 
    834                DO WHILE ( -zdeptht(jid,jj,jk1) < zuijk ) 
     830               DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 
    835831                 IF( jk1 == 1 ) THEN 
    836                    zbhitwe = 1 
     832                   zdeps = zdept(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad) 
     833                   zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 
     834                                                     bsp(jid,jj,1),   csp(jid,jj,1), & 
     835                                                     dsp(jid,jj,1)) * zdeps 
     836                   zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
    837837                   EXIT 
    838838                 ENDIF 
    839                  zdeps = MAX(zdeptht(jid,jj,jk1-1), -zuijk) 
     839                 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 
    840840                 zpwed = zpwed +                                        &  
    841                         integ2(zdeps,              zdeptht(jid,jj,jk1), & 
     841                        integ_spline(zdeps,              zdept(jid,jj,jk1), & 
    842842                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
    843843                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 
     
    845845               END DO 
    846846             
    847                IF( zbhitwe == 1 ) THEN 
    848                  zdeps = zdeptht(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad) 
    849                  zrhdt1 = zrhh(jid,jj,1) - interp3(zdeptht(jid,jj,1), asp(jid,jj,1), & 
    850                                                  bsp(jid,jj,1),    csp(jid,jj,1), & 
    851                                                  dsp(jid,jj,1)) * zdeps 
    852                  zrhdt1 = MAX(zrhdt1, 1000._wp - rau0)        ! no lighter than fresh water 
    853                  zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
    854                ENDIF 
    855  
    856847               ! update the momentum trends in u direction 
    857848 
     
    870861            !!!!!     for v equation 
    871862            IF( jk <= mbkv(ji,jj) ) THEN 
    872                IF( -zdeptht(ji,jj+1,mbkv(ji,jj)) >= -zdeptht(ji,jj,mbkv(ji,jj)) ) THEN 
     863               IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 
    873864                 jjs = jj + 1; jjd = jj 
    874865               ELSE 
     
    878869               ! integrate the pressure on the shallow side 
    879870               jk1 = jk  
    880                zbhitns = 0 
    881                DO WHILE ( -zdeptht(ji,jjs,jk1) > zvijk ) 
     871               DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 
    882872                 IF( jk1 == mbkv(ji,jj) ) THEN 
    883                    zbhitns = 1 
     873                   zvijk = -zdept(ji,jjs,jk1) 
    884874                   EXIT 
    885875                 ENDIF 
    886                  zdeps = MIN(zdeptht(ji,jjs,jk1+1), -zvijk) 
     876                 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 
    887877                 zpnss = zpnss +                                      &  
    888                         integ2(zdeptht(ji,jjs,jk1), zdeps,            & 
     878                        integ_spline(zdept(ji,jjs,jk1), zdeps,            & 
    889879                               asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), & 
    890880                               csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) ) 
     
    892882               END DO 
    893883             
    894                IF(zbhitns == 1) THEN 
    895                  zvijk = -zdeptht(ji,jjs,jk1) 
    896                ENDIF 
    897  
    898884               ! integrate the pressure on the deep side 
    899885               jk1 = jk  
    900                zbhitns = 0 
    901                DO WHILE ( -zdeptht(ji,jjd,jk1) < zvijk ) 
     886               DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 
    902887                 IF( jk1 == 1 ) THEN 
    903                    zbhitns = 1 
     888                   zdeps = zdept(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad) 
     889                   zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 
     890                                                     bsp(ji,jjd,1),   csp(ji,jjd,1), & 
     891                                                     dsp(ji,jjd,1) ) * zdeps 
     892                   zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
    904893                   EXIT 
    905894                 ENDIF 
    906                  zdeps = MAX(zdeptht(ji,jjd,jk1-1), -zvijk) 
     895                 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 
    907896                 zpnsd = zpnsd +                                        &  
    908                         integ2(zdeps,              zdeptht(ji,jjd,jk1), & 
     897                        integ_spline(zdeps,              zdept(ji,jjd,jk1), & 
    909898                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 
    910899                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 
     
    912901               END DO 
    913902             
    914                IF( zbhitns == 1 ) THEN 
    915                  zdeps = zdeptht(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad) 
    916                  zrhdt1 = zrhh(ji,jjd,1) - interp3(zdeptht(ji,jjd,1), asp(ji,jjd,1), & 
    917                                                  bsp(ji,jjd,1),    csp(ji,jjd,1), & 
    918                                                  dsp(ji,jjd,1) ) * zdeps 
    919                  zrhdt1 = MAX(zrhdt1, 1000._wp - rau0)        ! no lighter than fresh water 
    920                  zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
    921                ENDIF 
    922903 
    923904               ! update the momentum trends in v direction 
     
    941922      ! 
    942923      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )  
    943       CALL wrk_dealloc( jpi,jpj,jpk, zdeptht, zrhh )  
     924      CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh )  
    944925      ! 
    945926   END SUBROUTINE hpg_prj 
     
    11211102 
    11221103    
    1123    FUNCTION integ2(xl, xr, a, b, c, d)  RESULT(f)  
     1104   FUNCTION integ_spline(xl, xr, a, b, c, d)  RESULT(f)  
    11241105      !!---------------------------------------------------------------------- 
    11251106      !!                 ***  ROUTINE interp1  *** 
     
    11431124         & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) ) 
    11441125 
    1145    END FUNCTION integ2 
     1126   END FUNCTION integ_spline 
    11461127 
    11471128 
    11481129   !!====================================================================== 
    11491130END MODULE dynhpg 
     1131 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3625 r3632  
    8181   END INTERFACE 
    8282   INTERFACE mpp_sum 
    83 # if defined key_mpp_rep 
    8483      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 
    8584                       mppsum_realdd, mppsum_a_realdd 
    86 # else 
    87       MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real 
    88 # endif 
    8985   END INTERFACE 
    9086   INTERFACE mpp_lbc_north 
     
    115111!$AGRIF_END_DO_NOT_TREAT 
    116112 
    117 # if defined key_mpp_rep 
    118113   INTEGER :: MPI_SUMDD 
    119 # endif 
    120114 
    121115   ! variables used in case of sea-ice 
     
    350344      mynode = mpprank 
    351345      !  
    352 #if defined key_mpp_rep 
    353346      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
    354 #endif 
    355347      ! 
    356348   END FUNCTION mynode 
     
    15081500   END SUBROUTINE mppsum_real 
    15091501 
    1510 # if defined key_mpp_rep 
    15111502   SUBROUTINE mppsum_realdd( ytab, kcom ) 
    15121503      !!---------------------------------------------------------------------- 
     
    15611552 
    15621553   END SUBROUTINE mppsum_a_realdd 
    1563 # endif    
    15641554    
    15651555   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) 
     
    26042594   END SUBROUTINE mpi_init_opa 
    26052595 
    2606 #if defined key_mpp_rep 
    26072596   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype) 
    26082597      !!--------------------------------------------------------------------- 
     
    26332622 
    26342623   END SUBROUTINE DDPDD_MPI 
    2635 #endif 
    26362624 
    26372625#else 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r3625 r3632  
    723723               !                                                       ! (geographical to local grid -> rotate the components) 
    724724               CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    725                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    726725               IF( srcv(jpr_otx2)%laction ) THEN 
    727726                  CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     
    729728                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
    730729               ENDIF 
     730               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    731731               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    732732            ENDIF 
     
    953953               !                                                       ! (geographical to local grid -> rotate the components) 
    954954               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )    
    955                frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    956955               IF( srcv(jpr_itx2)%laction ) THEN 
    957956                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )    
     
    959958                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )   
    960959               ENDIF 
     960               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    961961               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid 
    962962            ENDIF 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3625 r3632  
    289289      !                                            !==  Misc. Options  ==! 
    290290       
    291       SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over sea-ice areas 
    292       CASE(  1 )   ;       CALL sbc_ice_if   ( kt )                  ! Ice-cover climatology ("Ice-if" model) 
    293          !                                                       
    294       CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )            ! LIM-2 ice model 
    295          IF( lk_bdy )      CALL bdy_ice_lim_2( kt )                  ! BDY boundary condition 
    296          !                                                      
    297       CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc )            ! LIM-3 ice model 
    298          ! 
    299       CASE(  4 )   ;       CALL sbc_ice_cice ( kt, nsbc )            ! CICE ice model 
     291      SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas 
     292      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model) 
     293      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
     294              IF( lk_bdy )   CALL bdy_ice_lim_2( kt )                ! BDY boundary condition 
     295      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
     296      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
    300297      END SELECT                                               
    301298 
    302       IF( ln_icebergs )    CALL icb_stp( kt )                   ! compute icebergs 
    303  
    304       IF( ln_rnf       )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 
     299      IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs 
     300 
     301      IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 
    305302  
    306       IF( ln_ssr       )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term 
    307  
    308       IF( nn_fwb  /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
    309  
    310       IF( nclosea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain  
    311       !                                                         ! (update freshwater fluxes) 
     303      IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term 
     304 
     305      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
     306 
     307      IF( nn_closea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain  
     308      !                                                           ! (update freshwater fluxes) 
    312309!RBbug do not understand why see ticket 667 
    313310      CALL lbc_lnk( emp, 'T', 1. ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r3625 r3632  
    453453      CALL iom_close( inum )                                      ! close file 
    454454      ! 
    455       IF( nclosea == 1 )    CALL clo_rnf( rnfmsk )                ! closed sea inflow set as ruver mouth 
    456       ! 
    457       rnfmsk_z(:)   = 0._wp                                        ! vertical structure  
     455      IF( nn_closea == 1 )   CALL clo_rnf( rnfmsk )               ! closed sea inflow set as ruver mouth 
     456      ! 
     457      rnfmsk_z(:)   = 0._wp                                       ! vertical structure  
    458458      rnfmsk_z(1)   = 1.0 
    459459      rnfmsk_z(2)   = 1.0                                         ! ********** 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r3294 r3632  
    225225            DO jj = 2, jpjm1 
    226226               DO ji = fs_2, fs_jpim1  ! vector opt. 
    227                   zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + & 
    228                        &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
     227                  zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 
     228                       &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
    229229               END DO 
    230230            END DO 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r3294 r3632  
    88   !!            3.3  !  2010-06  (C. Ethe) merge TRA-TRC  
    99   !!---------------------------------------------------------------------- 
    10 #if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc  
     10#if  defined key_trdtra || defined key_trdtrc || defined key_trdmld || defined key_trdmld_trc  
    1111   !!---------------------------------------------------------------------- 
    1212   !!   trd_tra      : Call the trend to be computed 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r3625 r3632  
    8888   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau) 
    8989   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz 
    9092#if defined key_c1d 
    9193   !                                                                        !!** 1D cfg only  **   ('key_c1d') 
     
    113115         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          & 
    114116#endif 
    115          &      en   (jpi,jpj,jpk) , htau (jpi,jpj)     , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 
     117         &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     &  
     118         &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                          & 
     119         &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc      ) 
    116120         ! 
    117121      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
     
    169173      !!---------------------------------------------------------------------- 
    170174      ! 
     175      IF( kt /= nit000 ) THEN   ! restore before value to compute tke 
     176         avt (:,:,:) = avt_k (:,:,:)  
     177         avm (:,:,:) = avm_k (:,:,:)  
     178         avmu(:,:,:) = avmu_k(:,:,:)  
     179         avmv(:,:,:) = avmv_k(:,:,:)  
     180      ENDIF  
     181      ! 
    171182      CALL tke_tke      ! now tke (en) 
    172183      ! 
    173184      CALL tke_avn      ! now avt, avm, avmu, avmv 
     185      ! 
     186      avt_k (:,:,:) = avt (:,:,:)  
     187      avm_k (:,:,:) = avm (:,:,:)  
     188      avmu_k(:,:,:) = avmu(:,:,:)  
     189      avmv_k(:,:,:) = avmv(:,:,:)  
    174190      ! 
    175191   END SUBROUTINE zdf_tke 
     
    812828        !                                   ! ------------------- 
    813829        IF(lwp) WRITE(numout,*) '---- tke-rst ----' 
    814         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    ) 
    815         CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt   ) 
    816         CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm   ) 
    817         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu  ) 
    818         CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv  ) 
    819         CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl ) 
     830        CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     ) 
     831        CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k  ) 
     832        CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  ) 
     833        CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 
     834        CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k ) 
     835        CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl  ) 
    820836        ! 
    821837     ENDIF 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r3294 r3632  
    1414   !!                 of intrinsinc sign function 
    1515   !!---------------------------------------------------------------------- 
    16    USE par_oce          ! Ocean parameter 
    17    USE lib_mpp          ! distributed memory computing 
    18    USE dom_oce          ! ocean domain 
    19    USE in_out_manager   ! I/O manager 
     16   USE par_oce         ! Ocean parameter 
     17   USE dom_oce         ! ocean domain 
     18   USE in_out_manager  ! I/O manager 
     19   USE lib_mpp         ! distributed memory computing 
    2020 
    2121   IMPLICIT NONE 
    2222   PRIVATE 
    2323 
    24    PUBLIC glob_sum 
     24   PUBLIC   glob_sum   ! used in many places 
     25   PUBLIC   DDPDD      ! also used in closea module 
    2526#if defined key_nosignedzero 
    2627   PUBLIC SIGN 
     
    4748 
    4849#if ! defined key_mpp_rep 
     50 
    4951   FUNCTION glob_sum_2d( ptab )  
    5052      !!----------------------------------------------------------------------- 
     
    246248   END FUNCTION glob_sum_3d_a    
    247249 
     250#endif 
    248251 
    249252   SUBROUTINE DDPDD( ydda, yddb ) 
     
    280283      ! 
    281284   END SUBROUTINE DDPDD 
    282 #endif 
    283285 
    284286#if defined key_nosignedzero 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r3625 r3632  
    296296      ENDIF 
    297297      ! 
    298       CALL wrk_alloc( jpi, jpj, jpk, znum3d ) 
     298      CALL wrk_dealloc( jpi, jpj, jpk, znum3d ) 
    299299      ! 
    300300      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink') 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r3294 r3632  
    101101      END SELECT 
    102102 
    103       IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
     103      IF( l_trdtrc )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    104104         DO jn = 1, jptra 
    105105            DO jk = 1, jpkm1 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90

    r3294 r3632  
    5959      ! Mixed layer trends for passive tracers 
    6060      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     61#if defined key_trdmld_trc   
    6162      IF( lk_trdmld_trc .AND. ln_trdtrc( kjn ) ) THEN 
    6263         ! 
     
    8283         ! 
    8384      END IF 
     85#endif 
    8486 
    8587      IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN 
    8688         ! 
    8789         SELECT CASE( ktrd ) 
    88          CASE( jptra_trd_xad )       ;    WRITE (cltra,'("XAD_",16a)')   ctrcnm(kjn) 
    89          CASE( jptra_trd_yad )       ;    WRITE (cltra,'("YAD_",16a)')   ctrcnm(kjn) 
    90          CASE( jptra_trd_zad )       ;    WRITE (cltra,'("ZAD_",16a)')   ctrcnm(kjn) 
    91          CASE( jptra_trd_ldf )       ;    WRITE (cltra,'("LDF_",16a)')   ctrcnm(kjn) 
    92          CASE( jptra_trd_bbl )       ;    WRITE (cltra,'("BBL_",16a)')   ctrcnm(kjn) 
    93          CASE( jptra_trd_zdf )       ;    WRITE (cltra,'("ZDF_",16a)')   ctrcnm(kjn) 
    94          CASE( jptra_trd_dmp )       ;    WRITE (cltra,'("DMP_",16a)')   ctrcnm(kjn) 
    95          CASE( jptra_trd_nsr )       ;    WRITE (cltra,'("FOR_",16a)')   ctrcnm(kjn) 
     90         CASE( jptra_trd_xad  )       ;    WRITE (cltra,'("XAD_",4a)') 
     91         CASE( jptra_trd_yad  )       ;    WRITE (cltra,'("YAD_",4a)') 
     92         CASE( jptra_trd_zad  )       ;    WRITE (cltra,'("ZAD_",4a)') 
     93         CASE( jptra_trd_ldf  )       ;    WRITE (cltra,'("LDF_",4a)') 
     94         CASE( jptra_trd_bbl  )       ;    WRITE (cltra,'("BBL_",4a)') 
     95         CASE( jptra_trd_nsr  )       ;    WRITE (cltra,'("FOR_",4a)') 
     96         CASE( jptra_trd_zdf  )       ;    WRITE (cltra,'("ZDF_",4a)') 
     97         CASE( jptra_trd_dmp  )       ;    WRITE (cltra,'("DMP_",4a)') 
     98         CASE( jptra_trd_sms  )       ;    WRITE (cltra,'("SMS_",4a)') 
     99         CASE( jptra_trd_atf  )       ;    WRITE (cltra,'("ATF_",4a)') 
     100         CASE( jptra_trd_radb )       ;    WRITE (cltra,'("RDB_",4a)') 
     101         CASE( jptra_trd_radn )       ;    WRITE (cltra,'("RDN_",4a)') 
    96102         END SELECT 
     103                                          cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
    97104                                          CALL iom_put( cltra,  ptrtrd(:,:,:) ) 
    98105         ! 
     
    111118      !!---------------------------------------------------------------------- 
    112119 
     120#if defined key_trdmld_trc   
    113121      CALL trd_mld_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends 
     122#endif 
    114123 
    115124   END SUBROUTINE trd_mod_trc_bio 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90

    r3294 r3632  
    370370        DO WHILE ( (  sec%listPoint(jseg)%I .NE.  endingPoint%I    & 
    371371                 .OR. sec%listPoint(jseg)%J .NE. endingPoint%J   ) & 
    372                  .AND. jseg .LT. nb_inmesh + 1 .AND. sec%listPoint(jseg)%I .GT. 0  )          
     372                 .AND. jseg .LT. nb_inmesh + 10 .AND. sec%listPoint(jseg)%I .GT. 0  )          
    373373    
    374374           ! a. find the 4 adjacent points (North, South, East, West) 
     
    429429           !-------------------- 
    430430           IF(      SouthPoint%I==endingPoint%I .AND. SouthPoint%J==endingPoint%J )THEN  
    431                jseg = jseg+1 ; sec%listPoint(jseg) = SouthPoint 
     431               sec%direction(jseg)=2 ; jseg = jseg+1 ; sec%listPoint(jseg) = SouthPoint 
    432432           ELSE IF( NorthPoint%I==endingPoint%I .AND. NorthPoint%J==endingPoint%J )THEN 
    433                jseg = jseg+1 ; sec%listPoint(jseg) = NorthPoint 
     433               sec%direction(jseg)=3 ; jseg = jseg+1 ; sec%listPoint(jseg) = NorthPoint 
    434434           ELSE IF(  WestPoint%I==endingPoint%I .AND.  WestPoint%J==endingPoint%J )THEN 
    435                jseg = jseg+1 ; sec%listPoint(jseg) = WestPoint 
     435               sec%direction(jseg)=0 ; jseg = jseg+1 ; sec%listPoint(jseg) = WestPoint 
    436436           ELSE IF(   EstPoint%I==endingPoint%I .AND.   EstPoint%J==endingPoint%J )THEN 
    437                jseg = jseg+1 ; sec%listPoint(jseg) = EstPoint 
     437               sec%direction(jseg)=1 ; jseg = jseg+1 ; sec%listPoint(jseg) = EstPoint 
    438438 
    439439           ELSE 
Note: See TracChangeset for help on using the changeset viewer.