Changeset 3632
- Timestamp:
- 2012-11-22T16:28:42+01:00 (11 years ago)
- Location:
- branches/2012/dev_NOC_2012_rev3555/NEMOGCM
- Files:
-
- 23 edited
- 1 copied
-
ARCH/CNRS/arch-ifort_CICLAD.fcm (copied) (copied from trunk/NEMOGCM/ARCH/CNRS/arch-ifort_CICLAD.fcm)
-
CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces (modified) (7 diffs)
-
CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces (modified) (7 diffs)
-
NEMO/OFF_SRC/domain.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/BDY/bdyini.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DIA/diadct.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DIA/diawri.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DOM/closea.F90 (modified) (9 diffs)
-
NEMO/OPA_SRC/DOM/dom_oce.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DOM/domain.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/DYN/dynhpg.F90 (modified) (16 diffs)
-
NEMO/OPA_SRC/LBC/lib_mpp.F90 (modified) (7 diffs)
-
NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/SBC/sbcmod.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/SBC/sbcrnf.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/traldf_iso_grif.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRD/trdtra.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/ZDF/zdftke.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/lib_fortran.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/p4zsink.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/TRP/trczdf.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/TRP/trdmod_trc.F90 (modified) (3 diffs)
-
TOOLS/SECTIONS_DIADCT/src/compute_sections.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces
r3294 r3632 16 16 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 17 17 ln_co2int = .false. ! read atm pco2 from a file (T) or constant (F) 18 atcco2 = 28 7. ! Constant value atmospheric pCO2 - ln_co2int = F18 atcco2 = 280. ! Constant value atmospheric pCO2 - ln_co2int = F 19 19 clname = 'atcco2.txt' ! Name of atm pCO2 file - ln_co2int = T 20 20 nn_offset = 0 ! Offset model-data start year - ln_co2int = T … … 35 35 &nampisbio ! biological parameters 36 36 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 37 nrdttrc = 1! time step frequency for biology37 nrdttrc = 4 ! time step frequency for biology 38 38 wsbio = 2. ! POC sinking speed 39 xkmort = 1.E-7 ! half saturation constant for mortality39 xkmort = 2.E-7 ! half saturation constant for mortality 40 40 ferat3 = 10.E-6 ! Fe/C in zooplankton 41 41 wsbio2 = 30. ! Big particles sinking speed … … 44 44 &nampislim ! parameters for nutrient limitations 45 45 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 46 conc0 = 2.e-6 ! Phosphate half saturation46 conc0 = 1.e-6 ! Phosphate half saturation 47 47 conc1 = 8E-6 ! Phosphate half saturation for diatoms 48 conc2 = 2E-9 ! Iron half saturation for phyto49 conc2m = 4E-9 ! Max iron half saturation for phyto48 conc2 = 1E-9 ! Iron half saturation for phyto 49 conc2m = 3E-9 ! Max iron half saturation for phyto 50 50 conc3 = 3E-9 ! Iron half saturation for diatoms 51 conc3m = 9E-9 ! Maxi iron half saturation for diatoms52 xsizedia = 5.E-7! Minimum size criteria for diatoms51 conc3m = 8E-9 ! Maxi iron half saturation for diatoms 52 xsizedia = 1.E-6 ! Minimum size criteria for diatoms 53 53 xsizephy = 1.E-6 ! Minimum size criteria for phyto 54 54 concnnh4 = 1.E-7 ! NH4 half saturation for phyto 55 concdnh4 = 4.E-7 ! NH4 half saturation for diatoms55 concdnh4 = 8.E-7 ! NH4 half saturation for diatoms 56 56 xksi1 = 2.E-6 ! half saturation constant for Si uptake 57 57 xksi2 = 3.33E-6 ! half saturation constant for Si/C 58 58 xkdoc = 417.E-6 ! half-saturation constant of DOC remineralization 59 concfebac = 3.E-11 ! Half-saturation for Fe limitation of Bacteria59 concfebac = 1.E-11 ! Half-saturation for Fe limitation of Bacteria 60 60 qnfelim = 7.E-6 ! Optimal quota of phyto 61 61 qdfelim = 7.E-6 ! Optimal quota of diatoms … … 65 65 &nampisprod ! parameters for phytoplankton growth 66 66 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 67 pislope = 3. ! P-I slope67 pislope = 2. ! P-I slope 68 68 pislope2 = 2. ! P-I slope for diatoms 69 69 excret = 0.05 ! excretion ratio of phytoplankton 70 70 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) 72 72 bresp = 0.00333 ! Basal respiration rate 73 73 chlcnm = 0.033 ! Minimum Chl/C in nanophytoplankton 74 chlcdm = 0.0 4! Minimum Chl/C in diatoms74 chlcdm = 0.05 ! Minimum Chl/C in diatoms 75 75 chlcmin = 0.0033 ! Maximum Chl/c in phytoplankton 76 76 fecnm = 40E-6 ! Maximum Fe/C in nanophytoplankton … … 100 100 xthresh2zoo = 1E-8 ! zoo feeding threshold for mesozooplankton 101 101 xthresh2dia = 1E-8 ! diatoms feeding threshold for mesozooplankton 102 xthresh2phy = 2E-7! nanophyto feeding threshold for mesozooplankton102 xthresh2phy = 1E-8 ! nanophyto feeding threshold for mesozooplankton 103 103 xthresh2poc = 1E-8 ! poc feeding threshold for mesozooplankton 104 xthresh2 = 0.! Food threshold for grazing104 xthresh2 = 2E-7 ! Food threshold for grazing 105 105 xkgraz2 = 20.E-6 ! half sturation constant for meso grazing 106 epsher2 = 0.3 3! Efficicency of Mesozoo growth106 epsher2 = 0.3 ! Efficicency of Mesozoo growth 107 107 sigma2 = 0.6 ! Fraction of mesozoo excretion as DOM 108 108 unass2 = 0.3 ! non assimilated fraction of P by mesozoo 109 grazflux = 3.e3 ! flux-feeding rate109 grazflux = 2.e3 ! flux-feeding rate 110 110 / 111 111 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' … … 115 115 grazrat = 3.0 ! maximal zoo grazing rate 116 116 resrat = 0.03 ! exsudation rate of zooplankton 117 mzrat = 0.0 117 mzrat = 0.001 ! zooplankton mortality rate 118 118 xpref2c = 0.1 ! Microzoo preference for POM 119 119 xpref2p = 1. ! Microzoo preference for Nanophyto 120 xpref2d = 0. 6! Microzoo preference for Diatoms120 xpref2d = 0.5 ! Microzoo preference for Diatoms 121 121 xthreshdia = 1.E-8 ! Diatoms feeding threshold for microzooplankton 122 xthreshphy = 2.E-7! Nanophyto feeding threshold for microzooplankton122 xthreshphy = 1.E-8 ! Nanophyto feeding threshold for microzooplankton 123 123 xthreshpoc = 1.E-8 ! POC feeding threshold for microzooplankton 124 xthresh = 0.! Food threshold for feeding124 xthresh = 2.E-7 ! Food threshold for feeding 125 125 xkgraz = 20.E-6 ! half sturation constant for grazing 126 epsher = 0.3 3! Efficiency of microzoo growth126 epsher = 0.3 ! Efficiency of microzoo growth 127 127 sigma1 = 0.6 ! Fraction of microzoo excretion as DOM 128 128 unass = 0.3 ! non assimilated fraction of phyto by zoo … … 160 160 cn_dir = './' ! root directory for the location of the dynamical files 161 161 ln_dust = .true. ! boolean for dust input from the atmosphere 162 ln_river = . true. ! boolean for river input of nutrients162 ln_river = .false. ! boolean for river input of nutrients 163 163 ln_ndepo = .true. ! boolean for atmospheric deposition of N 164 164 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 16 16 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 17 17 ln_co2int = .false. ! read atm pco2 from a file (T) or constant (F) 18 atcco2 = 28 7. ! Constant value atmospheric pCO2 - ln_co2int = F18 atcco2 = 280. ! Constant value atmospheric pCO2 - ln_co2int = F 19 19 clname = 'atcco2.txt' ! Name of atm pCO2 file - ln_co2int = T 20 20 nn_offset = 0 ! Offset model-data start year - ln_co2int = T … … 37 37 nrdttrc = 4 ! time step frequency for biology 38 38 wsbio = 2. ! POC sinking speed 39 xkmort = 1.E-7 ! half saturation constant for mortality39 xkmort = 2.E-7 ! half saturation constant for mortality 40 40 ferat3 = 10.E-6 ! Fe/C in zooplankton 41 41 wsbio2 = 30. ! Big particles sinking speed … … 44 44 &nampislim ! parameters for nutrient limitations 45 45 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 46 conc0 = 2.e-6 ! Phosphate half saturation46 conc0 = 1.e-6 ! Phosphate half saturation 47 47 conc1 = 8E-6 ! Phosphate half saturation for diatoms 48 conc2 = 2E-9 ! Iron half saturation for phyto49 conc2m = 4E-9 ! Max iron half saturation for phyto48 conc2 = 1E-9 ! Iron half saturation for phyto 49 conc2m = 3E-9 ! Max iron half saturation for phyto 50 50 conc3 = 3E-9 ! Iron half saturation for diatoms 51 conc3m = 9E-9 ! Maxi iron half saturation for diatoms52 xsizedia = 5.E-7! Minimum size criteria for diatoms51 conc3m = 8E-9 ! Maxi iron half saturation for diatoms 52 xsizedia = 1.E-6 ! Minimum size criteria for diatoms 53 53 xsizephy = 1.E-6 ! Minimum size criteria for phyto 54 54 concnnh4 = 1.E-7 ! NH4 half saturation for phyto 55 concdnh4 = 4.E-7 ! NH4 half saturation for diatoms55 concdnh4 = 8.E-7 ! NH4 half saturation for diatoms 56 56 xksi1 = 2.E-6 ! half saturation constant for Si uptake 57 57 xksi2 = 3.33E-6 ! half saturation constant for Si/C 58 58 xkdoc = 417.E-6 ! half-saturation constant of DOC remineralization 59 concfebac = 3.E-11 ! Half-saturation for Fe limitation of Bacteria59 concfebac = 1.E-11 ! Half-saturation for Fe limitation of Bacteria 60 60 qnfelim = 7.E-6 ! Optimal quota of phyto 61 61 qdfelim = 7.E-6 ! Optimal quota of diatoms … … 65 65 &nampisprod ! parameters for phytoplankton growth 66 66 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 67 pislope = 3. ! P-I slope67 pislope = 2. ! P-I slope 68 68 pislope2 = 2. ! P-I slope for diatoms 69 69 excret = 0.05 ! excretion ratio of phytoplankton 70 70 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) 72 72 bresp = 0.00333 ! Basal respiration rate 73 73 chlcnm = 0.033 ! Minimum Chl/C in nanophytoplankton 74 chlcdm = 0.0 4! Minimum Chl/C in diatoms74 chlcdm = 0.05 ! Minimum Chl/C in diatoms 75 75 chlcmin = 0.0033 ! Maximum Chl/c in phytoplankton 76 76 fecnm = 40E-6 ! Maximum Fe/C in nanophytoplankton … … 100 100 xthresh2zoo = 1E-8 ! zoo feeding threshold for mesozooplankton 101 101 xthresh2dia = 1E-8 ! diatoms feeding threshold for mesozooplankton 102 xthresh2phy = 2E-7! nanophyto feeding threshold for mesozooplankton102 xthresh2phy = 1E-8 ! nanophyto feeding threshold for mesozooplankton 103 103 xthresh2poc = 1E-8 ! poc feeding threshold for mesozooplankton 104 xthresh2 = 0.! Food threshold for grazing104 xthresh2 = 2E-7 ! Food threshold for grazing 105 105 xkgraz2 = 20.E-6 ! half sturation constant for meso grazing 106 epsher2 = 0.3 3! Efficicency of Mesozoo growth106 epsher2 = 0.3 ! Efficicency of Mesozoo growth 107 107 sigma2 = 0.6 ! Fraction of mesozoo excretion as DOM 108 108 unass2 = 0.3 ! non assimilated fraction of P by mesozoo 109 grazflux = 3.e3 ! flux-feeding rate109 grazflux = 2.e3 ! flux-feeding rate 110 110 / 111 111 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' … … 115 115 grazrat = 3.0 ! maximal zoo grazing rate 116 116 resrat = 0.03 ! exsudation rate of zooplankton 117 mzrat = 0.0 117 mzrat = 0.001 ! zooplankton mortality rate 118 118 xpref2c = 0.1 ! Microzoo preference for POM 119 119 xpref2p = 1. ! Microzoo preference for Nanophyto 120 xpref2d = 0. 6! Microzoo preference for Diatoms120 xpref2d = 0.5 ! Microzoo preference for Diatoms 121 121 xthreshdia = 1.E-8 ! Diatoms feeding threshold for microzooplankton 122 xthreshphy = 2.E-7! Nanophyto feeding threshold for microzooplankton122 xthreshphy = 1.E-8 ! Nanophyto feeding threshold for microzooplankton 123 123 xthreshpoc = 1.E-8 ! POC feeding threshold for microzooplankton 124 xthresh = 0.! Food threshold for feeding124 xthresh = 2.E-7 ! Food threshold for feeding 125 125 xkgraz = 20.E-6 ! half sturation constant for grazing 126 epsher = 0.3 3! Efficiency of microzoo growth126 epsher = 0.3 ! Efficiency of microzoo growth 127 127 sigma1 = 0.6 ! Fraction of microzoo excretion as DOM 128 128 unass = 0.3 ! non assimilated fraction of phyto by zoo … … 160 160 cn_dir = './' ! root directory for the location of the dynamical files 161 161 ln_dust = .true. ! boolean for dust input from the atmosphere 162 ln_river = . true. ! boolean for river input of nutrients162 ln_river = .false. ! boolean for river input of nutrients 163 163 ln_ndepo = .true. ! boolean for atmospheric deposition of N 164 164 ln_ironsed = .true. ! boolean for Fe input from sediments -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OFF_SRC/domain.F90
r2574 r3632 205 205 rdtmax = rn_rdtmin 206 206 rdth = rn_rdth 207 nclosea = nn_closea208 207 209 208 REWIND( numnam ) ! Namelist cross land advection -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r3298 r3632 773 773 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 774 774 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 775 nbj => idx_bdy(ib_bdy)%nb i(ib,igrd)775 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 776 776 flagu => idx_bdy(ib_bdy)%flagu(ib) 777 777 bdysurftot = bdysurftot + hu (nbi , nbj) & … … 786 786 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 787 787 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 788 nbj => idx_bdy(ib_bdy)%nb i(ib,igrd)788 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 789 789 flagv => idx_bdy(ib_bdy)%flagv(ib) 790 790 bdysurftot = bdysurftot + hv (nbi, nbj ) & -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r3294 r3632 38 38 USE dianam ! build name of file 39 39 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 42 45 #endif 43 46 USE domvvl … … 362 365 WRITE(numout,*)" List of points in global domain:" 363 366 DO jpt=1,iptglo 364 WRITE(numout,*)' # I J ',jpt,coordtemp(jpt) 367 WRITE(numout,*)' # I J ',jpt,coordtemp(jpt),directemp(jpt) 365 368 ENDDO 366 369 ENDIF … … 403 406 404 407 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,iptloc406 408 DO jpt = 1,iptloc 407 409 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 408 410 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 409 WRITE(narea+200,*)'avant # I J : ',iiglo,ijglo410 411 ENDDO 411 412 ENDIF … … 421 422 ENDIF 422 423 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,iptloc424 424 DO jpt = 1,secs(jsec)%nb_point 425 425 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 426 426 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 427 WRITE(narea+200,*)'apres # I J : ',iiglo,ijglo428 427 ENDDO 429 428 ENDIF … … 626 625 ELSE ; isgnv = 1 627 626 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 630 630 631 631 !--------------------------------------! -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r3625 r3632 175 175 z3d(:,:,jpk) = 0.e0 176 176 DO jk = 1, jpkm1 177 z3d(:,:,jk) = rau0 * un(:,:,jk) * e 1u(:,:) * fse3u(:,:,jk)177 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 178 178 END DO 179 179 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction … … 190 190 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 191 191 DO jk = 1, jpkm1 192 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e 2v(:,:) * fse3v(:,:,jk)192 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 193 193 END DO 194 194 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 7 7 !! 8.5 ! 02-06 (E. Durand, G. Madec) F90 8 8 !! 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 9 10 !!---------------------------------------------------------------------- 10 11 … … 18 19 USE oce ! dynamics and tracers 19 20 USE dom_oce ! ocean space and time domain 20 USE phycst 21 USE phycst ! physical constants 21 22 USE in_out_manager ! I/O manager 22 23 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 25 28 26 29 IMPLICIT NONE … … 86 89 SELECT CASE ( jp_cfg ) 87 90 ! ! ======================= 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 ! ! ======================= 88 99 CASE ( 2 ) ! ORCA_R2 configuration 89 100 ! ! ======================= … … 174 185 !! put as run-off in open ocean. 175 186 !! 176 !! ** Action : emp updated surface freshwater fluxat kt187 !! ** Action : emp updated surface freshwater fluxes and associated heat content at kt 177 188 !!---------------------------------------------------------------------- 178 189 INTEGER, INTENT(in) :: kt ! ocean model time step 179 190 ! 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') 185 200 ! !------------------! 186 201 IF( kt == nit000 ) THEN ! Initialisation ! … … 190 205 IF(lwp) WRITE(numout,*)'~~~~~~~' 191 206 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 200 220 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 204 234 205 235 IF(lwp) WRITE(numout,*)' Closed sea surfaces' … … 216 246 ! !--------------------! 217 247 ! ! 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 227 271 228 272 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 230 274 zfwf(3) = zze2 231 275 zfwf(4) = zze2 232 276 ENDIF 233 277 278 zcorr = 0._wp 279 234 280 DO jc = 1, jpncs 235 281 ! 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) 246 316 ji = mi0(ncsir(jc,jn)) 247 317 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 274 326 ENDIF 275 ENDIF276 !277 DO jj = ncsj1(jc), ncsj2(jc)278 DO ji = ncsi1(jc), ncsi2(jc)279 zcoef = zfwf(jc) / surf(jc)280 zcoef1 = rcp *zcoef281 emp(ji,jj) = emp(ji,jj) - zcoef282 qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj)283 END DO 284 END DO285 !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 286 338 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') 289 356 ! 290 357 END SUBROUTINE sbc_clo 291 292 358 359 293 360 SUBROUTINE clo_rnf( p_rnfmsk ) 294 361 !!--------------------------------------------------------------------- … … 314 381 ii = mi0( ncsir(jc,jn) ) 315 382 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 ) 317 384 END DO 318 385 ENDIF … … 342 409 DO jj = ncsj1(jc), ncsj2(jc) 343 410 DO ji = ncsi1(jc), ncsi2(jc) 344 p_upsmsk(ji,jj) = 0.5 411 p_upsmsk(ji,jj) = 0.5_wp ! mixed upstream/centered scheme over closed seas 345 412 END DO 346 413 END DO … … 380 447 !!====================================================================== 381 448 END MODULE closea 449 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r3294 r3632 52 52 REAL(wp), PUBLIC :: rdtmax !: maximum time step on tracers 53 53 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)55 54 56 55 ! !!! associated variables -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r3294 r3632 238 238 rdtmax = rn_rdtmin 239 239 rdth = rn_rdth 240 nclosea = nn_closea241 240 242 241 REWIND( numnam ) ! Namelist cross land advection -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r3294 r3632 422 422 CALL iom_close( inum ) 423 423 mbathy(:,:) = INT( bathy(:,:) ) 424 ! ! =====================424 ! 425 425 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 426 ! ! =====================426 ! 427 427 IF( nn_cla == 0 ) THEN 428 428 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open … … 454 454 CALL iom_get ( inum, jpdom_data, 'Bathymetry', bathy ) 455 455 CALL iom_close( inum ) 456 ! ! =====================456 ! 457 457 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 458 ! ! =====================458 ! 459 459 IF( nn_cla == 0 ) THEN 460 460 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open … … 489 489 ENDIF 490 490 ! 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 ==! 507 494 IF( rn_hmin < 0._wp ) THEN ; ik = - INT( rn_hmin ) ! from a nb of level 508 495 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 678 678 REAL(wp) :: zrhdt1 679 679 REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 680 INTEGER :: zbhitwe, zbhitns 681 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdeptht, zrhh 680 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdept, zrhh 682 681 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 683 682 !!---------------------------------------------------------------------- 684 683 ! 685 684 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 686 CALL wrk_alloc( jpi,jpj,jpk, zdept ht, zrhh )685 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 687 686 ! 688 687 IF( kt == nit000 ) THEN … … 717 716 END DO 718 717 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(:,:,:) 738 729 739 730 ! Construct the vertical density profile with the … … 745 736 DO jj = 2, jpj 746 737 DO ji = 2, jpi 747 zrhdt1 = zrhh(ji,jj,1) - interp3(zdept ht(ji,jj,1),asp(ji,jj,1), &738 zrhdt1 = zrhh(ji,jj,1) - interp3(zdept(ji,jj,1),asp(ji,jj,1), & 748 739 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) 751 741 752 742 ! assuming linear profile across the top half surface layer … … 760 750 DO ji = 2, jpi 761 751 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + & 762 integ 2(zdeptht(ji,jj,jk-1), zdeptht(ji,jj,jk),&752 integ_spline(zdept(ji,jj,jk-1), zdept(ji,jj,jk),& 763 753 asp(ji,jj,jk-1), bsp(ji,jj,jk-1), & 764 754 csp(ji,jj,jk-1), dsp(ji,jj,jk-1)) … … 793 783 END DO 794 784 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 795 797 DO jk = 1, jpkm1 796 798 DO jj = 2, jpjm1 … … 803 805 !!!!! for u equation 804 806 IF( jk <= mbku(ji,jj) ) THEN 805 IF( -zdept ht(ji+1,jj,mbku(ji,jj)) >= -zdeptht(ji,jj,mbku(ji,jj)) ) THEN807 IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 806 808 jis = ji + 1; jid = ji 807 809 ELSE … … 811 813 ! integrate the pressure on the shallow side 812 814 jk1 = jk 813 zbhitwe = 0 814 DO WHILE ( -zdeptht(jis,jj,jk1) > zuijk ) 815 DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 815 816 IF( jk1 == mbku(ji,jj) ) THEN 816 z bhitwe = 1817 zuijk = -zdept(jis,jj,jk1) 817 818 EXIT 818 819 ENDIF 819 zdeps = MIN(zdept ht(jis,jj,jk1+1), -zuijk)820 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 820 821 zpwes = zpwes + & 821 integ 2(zdeptht(jis,jj,jk1), zdeps, &822 integ_spline(zdept(jis,jj,jk1), zdeps, & 822 823 asp(jis,jj,jk1), bsp(jis,jj,jk1), & 823 824 csp(jis,jj,jk1), dsp(jis,jj,jk1)) … … 825 826 END DO 826 827 827 IF(zbhitwe == 1) THEN828 zuijk = -zdeptht(jis,jj,jk1)829 ENDIF830 831 828 ! integrate the pressure on the deep side 832 829 jk1 = jk 833 zbhitwe = 0 834 DO WHILE ( -zdeptht(jid,jj,jk1) < zuijk ) 830 DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 835 831 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 837 837 EXIT 838 838 ENDIF 839 zdeps = MAX(zdept ht(jid,jj,jk1-1), -zuijk)839 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 840 840 zpwed = zpwed + & 841 integ 2(zdeps, zdeptht(jid,jj,jk1), &841 integ_spline(zdeps, zdept(jid,jj,jk1), & 842 842 asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1), & 843 843 csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) … … 845 845 END DO 846 846 847 IF( zbhitwe == 1 ) THEN848 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)) * zdeps852 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water853 zpwed = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps854 ENDIF855 856 847 ! update the momentum trends in u direction 857 848 … … 870 861 !!!!! for v equation 871 862 IF( jk <= mbkv(ji,jj) ) THEN 872 IF( -zdept ht(ji,jj+1,mbkv(ji,jj)) >= -zdeptht(ji,jj,mbkv(ji,jj)) ) THEN863 IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 873 864 jjs = jj + 1; jjd = jj 874 865 ELSE … … 878 869 ! integrate the pressure on the shallow side 879 870 jk1 = jk 880 zbhitns = 0 881 DO WHILE ( -zdeptht(ji,jjs,jk1) > zvijk ) 871 DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 882 872 IF( jk1 == mbkv(ji,jj) ) THEN 883 z bhitns = 1873 zvijk = -zdept(ji,jjs,jk1) 884 874 EXIT 885 875 ENDIF 886 zdeps = MIN(zdept ht(ji,jjs,jk1+1), -zvijk)876 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 887 877 zpnss = zpnss + & 888 integ 2(zdeptht(ji,jjs,jk1), zdeps, &878 integ_spline(zdept(ji,jjs,jk1), zdeps, & 889 879 asp(ji,jjs,jk1), bsp(ji,jjs,jk1), & 890 880 csp(ji,jjs,jk1), dsp(ji,jjs,jk1) ) … … 892 882 END DO 893 883 894 IF(zbhitns == 1) THEN895 zvijk = -zdeptht(ji,jjs,jk1)896 ENDIF897 898 884 ! integrate the pressure on the deep side 899 885 jk1 = jk 900 zbhitns = 0 901 DO WHILE ( -zdeptht(ji,jjd,jk1) < zvijk ) 886 DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 902 887 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 904 893 EXIT 905 894 ENDIF 906 zdeps = MAX(zdept ht(ji,jjd,jk1-1), -zvijk)895 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 907 896 zpnsd = zpnsd + & 908 integ 2(zdeps, zdeptht(ji,jjd,jk1), &897 integ_spline(zdeps, zdept(ji,jjd,jk1), & 909 898 asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 910 899 csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) … … 912 901 END DO 913 902 914 IF( zbhitns == 1 ) THEN915 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) ) * zdeps919 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water920 zpnsd = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps921 ENDIF922 903 923 904 ! update the momentum trends in v direction … … 941 922 ! 942 923 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 943 CALL wrk_dealloc( jpi,jpj,jpk, zdept ht, zrhh )924 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 944 925 ! 945 926 END SUBROUTINE hpg_prj … … 1121 1102 1122 1103 1123 FUNCTION integ 2(xl, xr, a, b, c, d) RESULT(f)1104 FUNCTION integ_spline(xl, xr, a, b, c, d) RESULT(f) 1124 1105 !!---------------------------------------------------------------------- 1125 1106 !! *** ROUTINE interp1 *** … … 1143 1124 & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) ) 1144 1125 1145 END FUNCTION integ 21126 END FUNCTION integ_spline 1146 1127 1147 1128 1148 1129 !!====================================================================== 1149 1130 END MODULE dynhpg 1131 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3625 r3632 81 81 END INTERFACE 82 82 INTERFACE mpp_sum 83 # if defined key_mpp_rep84 83 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 85 84 mppsum_realdd, mppsum_a_realdd 86 # else87 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real88 # endif89 85 END INTERFACE 90 86 INTERFACE mpp_lbc_north … … 115 111 !$AGRIF_END_DO_NOT_TREAT 116 112 117 # if defined key_mpp_rep118 113 INTEGER :: MPI_SUMDD 119 # endif120 114 121 115 ! variables used in case of sea-ice … … 350 344 mynode = mpprank 351 345 ! 352 #if defined key_mpp_rep353 346 CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 354 #endif355 347 ! 356 348 END FUNCTION mynode … … 1508 1500 END SUBROUTINE mppsum_real 1509 1501 1510 # if defined key_mpp_rep1511 1502 SUBROUTINE mppsum_realdd( ytab, kcom ) 1512 1503 !!---------------------------------------------------------------------- … … 1561 1552 1562 1553 END SUBROUTINE mppsum_a_realdd 1563 # endif1564 1554 1565 1555 SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) … … 2604 2594 END SUBROUTINE mpi_init_opa 2605 2595 2606 #if defined key_mpp_rep2607 2596 SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype) 2608 2597 !!--------------------------------------------------------------------- … … 2633 2622 2634 2623 END SUBROUTINE DDPDD_MPI 2635 #endif2636 2624 2637 2625 #else -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3625 r3632 723 723 ! ! (geographical to local grid -> rotate the components) 724 724 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 grid726 725 IF( srcv(jpr_otx2)%laction ) THEN 727 726 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) … … 729 728 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 730 729 ENDIF 730 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 731 731 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 732 732 ENDIF … … 953 953 ! ! (geographical to local grid -> rotate the components) 954 954 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 grid956 955 IF( srcv(jpr_itx2)%laction ) THEN 957 956 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) … … 959 958 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 960 959 ENDIF 960 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 961 961 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 962 962 ENDIF -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3625 r3632 289 289 ! !== Misc. Options ==! 290 290 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 300 297 END SELECT 301 298 302 IF( ln_icebergs )CALL icb_stp( kt ) ! compute icebergs303 304 IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes299 IF( ln_icebergs ) CALL icb_stp( kt ) ! compute icebergs 300 301 IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes 305 302 306 IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term307 308 IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget309 310 IF( n closea == 1 ) CALL sbc_clo( kt ) ! treatment of closed sea in the model domain311 ! ! (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) 312 309 !RBbug do not understand why see ticket 667 313 310 CALL lbc_lnk( emp, 'T', 1. ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r3625 r3632 453 453 CALL iom_close( inum ) ! close file 454 454 ! 455 IF( n closea == 1 ) CALL clo_rnf( rnfmsk )! closed sea inflow set as ruver mouth456 ! 457 rnfmsk_z(:) = 0._wp 455 IF( nn_closea == 1 ) CALL clo_rnf( rnfmsk ) ! closed sea inflow set as ruver mouth 456 ! 457 rnfmsk_z(:) = 0._wp ! vertical structure 458 458 rnfmsk_z(1) = 1.0 459 459 rnfmsk_z(2) = 1.0 ! ********** -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r3294 r3632 225 225 DO jj = 2, jpjm1 226 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2 v(ji,jj) + &228 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1 u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx227 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 229 229 END DO 230 230 END DO -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r3294 r3632 8 8 !! 3.3 ! 2010-06 (C. Ethe) merge TRA-TRC 9 9 !!---------------------------------------------------------------------- 10 #if defined key_trdtra || defined key_trd mld || defined key_trdmld_trc10 #if defined key_trdtra || defined key_trdtrc || defined key_trdmld || defined key_trdmld_trc 11 11 !!---------------------------------------------------------------------- 12 12 !! trd_tra : Call the trend to be computed -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r3625 r3632 88 88 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 89 89 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 90 92 #if defined key_c1d 91 93 ! !!** 1D cfg only ** ('key_c1d') … … 113 115 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 114 116 #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 ) 116 120 ! 117 121 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) … … 169 173 !!---------------------------------------------------------------------- 170 174 ! 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 ! 171 182 CALL tke_tke ! now tke (en) 172 183 ! 173 184 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(:,:,:) 174 190 ! 175 191 END SUBROUTINE zdf_tke … … 812 828 ! ! ------------------- 813 829 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 ) 820 836 ! 821 837 ENDIF -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r3294 r3632 14 14 !! of intrinsinc sign function 15 15 !!---------------------------------------------------------------------- 16 USE par_oce 17 USE lib_mpp ! distributed memory computing18 USE dom_oce ! ocean domain19 USE in_out_manager ! I/O manager16 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 20 20 21 21 IMPLICIT NONE 22 22 PRIVATE 23 23 24 PUBLIC glob_sum 24 PUBLIC glob_sum ! used in many places 25 PUBLIC DDPDD ! also used in closea module 25 26 #if defined key_nosignedzero 26 27 PUBLIC SIGN … … 47 48 48 49 #if ! defined key_mpp_rep 50 49 51 FUNCTION glob_sum_2d( ptab ) 50 52 !!----------------------------------------------------------------------- … … 246 248 END FUNCTION glob_sum_3d_a 247 249 250 #endif 248 251 249 252 SUBROUTINE DDPDD( ydda, yddb ) … … 280 283 ! 281 284 END SUBROUTINE DDPDD 282 #endif283 285 284 286 #if defined key_nosignedzero -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r3625 r3632 296 296 ENDIF 297 297 ! 298 CALL wrk_ alloc( jpi, jpj, jpk, znum3d )298 CALL wrk_dealloc( jpi, jpj, jpk, znum3d ) 299 299 ! 300 300 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink') -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r3294 r3632 101 101 END SELECT 102 102 103 IF( l_trdtr a) THEN ! save the vertical diffusive trends for further diagnostics103 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics 104 104 DO jn = 1, jptra 105 105 DO jk = 1, jpkm1 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90
r3294 r3632 59 59 ! Mixed layer trends for passive tracers 60 60 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 61 #if defined key_trdmld_trc 61 62 IF( lk_trdmld_trc .AND. ln_trdtrc( kjn ) ) THEN 62 63 ! … … 82 83 ! 83 84 END IF 85 #endif 84 86 85 87 IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN 86 88 ! 87 89 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)') 96 102 END SELECT 103 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 97 104 CALL iom_put( cltra, ptrtrd(:,:,:) ) 98 105 ! … … 111 118 !!---------------------------------------------------------------------- 112 119 120 #if defined key_trdmld_trc 113 121 CALL trd_mld_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends 122 #endif 114 123 115 124 END SUBROUTINE trd_mod_trc_bio -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90
r3294 r3632 370 370 DO WHILE ( ( sec%listPoint(jseg)%I .NE. endingPoint%I & 371 371 .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 ) 373 373 374 374 ! a. find the 4 adjacent points (North, South, East, West) … … 429 429 !-------------------- 430 430 IF( SouthPoint%I==endingPoint%I .AND. SouthPoint%J==endingPoint%J )THEN 431 jseg = jseg+1 ; sec%listPoint(jseg) = SouthPoint431 sec%direction(jseg)=2 ; jseg = jseg+1 ; sec%listPoint(jseg) = SouthPoint 432 432 ELSE IF( NorthPoint%I==endingPoint%I .AND. NorthPoint%J==endingPoint%J )THEN 433 jseg = jseg+1 ; sec%listPoint(jseg) = NorthPoint433 sec%direction(jseg)=3 ; jseg = jseg+1 ; sec%listPoint(jseg) = NorthPoint 434 434 ELSE IF( WestPoint%I==endingPoint%I .AND. WestPoint%J==endingPoint%J )THEN 435 jseg = jseg+1 ; sec%listPoint(jseg) = WestPoint435 sec%direction(jseg)=0 ; jseg = jseg+1 ; sec%listPoint(jseg) = WestPoint 436 436 ELSE IF( EstPoint%I==endingPoint%I .AND. EstPoint%J==endingPoint%J )THEN 437 jseg = jseg+1 ; sec%listPoint(jseg) = EstPoint437 sec%direction(jseg)=1 ; jseg = jseg+1 ; sec%listPoint(jseg) = EstPoint 438 438 439 439 ELSE
Note: See TracChangeset
for help on using the changeset viewer.
