Changeset 1804 for branches/dev_005_AWL/NEMO
- Timestamp:
- 2010-02-08T11:51:02+01:00 (14 years ago)
- Location:
- branches/dev_005_AWL/NEMO
- Files:
-
- 44 edited
- 5 copied
-
NST_SRC/agrif2model.F90 (modified) (1 diff)
-
OFF_SRC/DOM/domrea.F90 (modified) (4 diffs)
-
OPA_SRC/DIA/dianam.F90 (modified) (1 diff)
-
OPA_SRC/DIA/diawri.F90 (modified) (1 diff)
-
OPA_SRC/DOM/dom_oce.F90 (modified) (1 diff)
-
OPA_SRC/DOM/domain.F90 (modified) (1 diff)
-
OPA_SRC/DOM/domhgr.F90 (modified) (2 diffs)
-
OPA_SRC/DYN/divcur.F90 (modified) (3 diffs)
-
OPA_SRC/DYN/dynspg_flt.F90 (modified) (2 diffs)
-
OPA_SRC/DYN/sshwzv.F90 (modified) (1 diff)
-
OPA_SRC/IOM/iom.F90 (modified) (7 diffs)
-
OPA_SRC/SBC/sbcmod.F90 (modified) (1 diff)
-
OPA_SRC/SOL/solmat.F90 (modified) (2 diffs)
-
OPA_SRC/lib_mpp.F90 (modified) (4 diffs)
-
OPA_SRC/opa.F90 (modified) (3 diffs)
-
OPA_SRC/step.F90 (modified) (1 diff)
-
TOP_SRC/C14b/trclsm_c14b.F90 (modified) (3 diffs)
-
TOP_SRC/C14b/trcrst_c14b.F90 (copied) (copied from trunk/NEMO/TOP_SRC/C14b/trcrst_c14b.F90)
-
TOP_SRC/CFC/trcctl_cfc.F90 (modified) (3 diffs)
-
TOP_SRC/CFC/trclsm_cfc.F90 (modified) (3 diffs)
-
TOP_SRC/CFC/trcrst_cfc.F90 (copied) (copied from trunk/NEMO/TOP_SRC/CFC/trcrst_cfc.F90)
-
TOP_SRC/LOBSTER/trcbio.F90 (modified) (1 diff)
-
TOP_SRC/LOBSTER/trcexp.F90 (modified) (1 diff)
-
TOP_SRC/LOBSTER/trcini_lobster.F90 (modified) (1 diff)
-
TOP_SRC/LOBSTER/trcopt.F90 (modified) (1 diff)
-
TOP_SRC/LOBSTER/trcrst_lobster.F90 (copied) (copied from trunk/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90)
-
TOP_SRC/LOBSTER/trcsed.F90 (modified) (2 diffs)
-
TOP_SRC/MY_TRC/trcrst_my_trc.F90 (copied) (copied from trunk/NEMO/TOP_SRC/MY_TRC/trcrst_my_trc.F90)
-
TOP_SRC/PISCES/p4zbio.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zche.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zflx.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zlim.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zmeso.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zmicro.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zmort.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zopt.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zprod.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zrem.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/p4zsink.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/sms_pisces.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/trcini_pisces.F90 (modified) (1 diff)
-
TOP_SRC/PISCES/trclsm_pisces.F90 (modified) (2 diffs)
-
TOP_SRC/PISCES/trcrst_pisces.F90 (copied) (copied from trunk/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90)
-
TOP_SRC/TRP/trctrp.F90 (modified) (1 diff)
-
TOP_SRC/TRP/trczdf_imp.F90 (modified) (1 diff)
-
TOP_SRC/TRP/trczdf_iso.F90 (modified) (2 diffs)
-
TOP_SRC/TRP/trczdf_iso_vopt.F90 (modified) (4 diffs)
-
TOP_SRC/trcdta.F90 (modified) (5 diffs)
-
TOP_SRC/trcrst.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_005_AWL/NEMO/NST_SRC/agrif2model.F90
r1156 r1804 73 73 74 74 END SUBROUTINE Agrif_clustering_def 75 76 SUBROUTINE Agrif_comm_def(modelcomm) 77 78 !!--------------------------------------------- 79 !! *** ROUTINE Agrif_clustering_def *** 80 !!--------------------------------------------- 81 Use Agrif_Types 82 Use lib_mpp 83 84 IMPLICIT NONE 85 86 INTEGER :: modelcomm 87 88 #if defined key_mpp_mpi 89 modelcomm = mpi_comm_opa 90 #endif 91 Return 92 93 END SUBROUTINE Agrif_comm_def 75 94 #else 76 95 SUBROUTINE Agrif2Model -
branches/dev_005_AWL/NEMO/OFF_SRC/DOM/domrea.F90
r1641 r1804 215 215 216 216 217 DO jk = 1,jpk218 gdept(:,:,jk) = gdept_0(jk)219 gdepw(:,:,jk) = gdepw_0(jk)220 END DO221 222 223 217 IF( ln_zps ) THEN 218 ! Vertical coordinates and scales factors 219 CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth 220 CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 ) 221 CALL iom_get( inum4, jpdom_unknown, 'e3t_0' , e3t_0 ) 222 CALL iom_get( inum4, jpdom_unknown, 'e3w_0' , e3w_0 ) 224 223 ! z-coordinate - partial steps 225 224 IF( nmsh <= 6 ) THEN ! ! 3D vertical scale factors … … 233 232 END IF 234 233 235 IF( nmsh <= 3 ) THEN ! ! 3D depth234 IF( iom_varid( inum4, 'gdept', ldstop = .FALSE. ) > 0 ) THEN 236 235 CALL iom_get( inum4, jpdom_data, 'gdept', gdept ) ! scale factors 237 236 CALL iom_get( inum4, jpdom_data, 'gdepw', gdepw ) … … 240 239 CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw ) 241 240 241 DO jk = 1,jpk 242 gdept(:,:,jk) = gdept_0(jk) 243 gdepw(:,:,jk) = gdepw_0(jk) 244 ENDDO 245 242 246 DO jj = 1, jpj 243 247 DO ji = 1, jpi … … 252 256 END DO 253 257 END DO 258 254 259 ENDIF 255 260 256 261 ENDIF 257 ! Vertical coordinates and scales factors258 CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth259 CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )260 CALL iom_get( inum4, jpdom_unknown, 'e3t_0' , e3t_0 )261 CALL iom_get( inum4, jpdom_unknown, 'e3w_0' , e3w_0 )262 262 # endif 263 263 IF( ln_zco ) THEN -
branches/dev_005_AWL/NEMO/OPA_SRC/DIA/dianam.F90
r1731 r1804 129 129 130 130 cdfnam = TRIM(cexper)//TRIM(clave)//"_"//TRIM(cldate1)//"_"//TRIM(cldate2)//"_"//TRIM(cdsuff) 131 #if defined key_agrif 132 if ( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 133 #endif 131 IF( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 134 132 135 133 END SUBROUTINE dia_nam -
branches/dev_005_AWL/NEMO/OPA_SRC/DIA/diawri.F90
r1756 r1804 629 629 ! Define name, frequency of output and means 630 630 clname = cdfile_name 631 #if defined key_agrif 632 if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 633 #endif 631 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 634 632 zdt = rdt 635 633 zsto = rdt -
branches/dev_005_AWL/NEMO/OPA_SRC/DOM/dom_oce.F90
r1730 r1804 219 219 #else 220 220 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .FALSE. !: agrif flag 221 222 CONTAINS 223 LOGICAL FUNCTION Agrif_Root() 224 Agrif_Root = .TRUE. 225 END FUNCTION Agrif_Root 226 227 CHARACTER(len=3) FUNCTION Agrif_CFixed() 228 Agrif_CFixed = '0' 229 END FUNCTION Agrif_CFixed 221 230 #endif 222 231 -
branches/dev_005_AWL/NEMO/OPA_SRC/DOM/domain.F90
r1732 r1804 166 166 ENDIF 167 167 168 #if defined key_agrif169 168 IF( Agrif_Root() ) THEN 170 #endif 171 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 172 CASE ( 1 ) 173 CALL ioconf_calendar('gregorian') 174 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year' 175 CASE ( 0 ) 176 CALL ioconf_calendar('noleap') 177 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year' 178 CASE ( 30 ) 179 CALL ioconf_calendar('360d') 180 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year' 181 END SELECT 182 #if defined key_agrif 183 ENDIF 184 #endif 169 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 170 CASE ( 1 ) 171 CALL ioconf_calendar('gregorian') 172 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year' 173 CASE ( 0 ) 174 CALL ioconf_calendar('noleap') 175 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year' 176 CASE ( 30 ) 177 CALL ioconf_calendar('360d') 178 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year' 179 END SELECT 180 ENDIF 185 181 186 182 REWIND( numnam ) ! Namelist namdom : space & time domain (bathymetry, mesh, timestep) -
branches/dev_005_AWL/NEMO/OPA_SRC/DOM/domhgr.F90
r1707 r1804 270 270 271 271 #if defined key_agrif && defined key_eel_r6 272 IF (.Not.Agrif_Root()) THEN272 IF( .NOT. Agrif_Root() ) THEN 273 273 glam0 = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-3 274 274 gphi0 = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-3 … … 465 465 466 466 #if defined key_agrif && defined key_eel_r6 467 IF (.Not.Agrif_Root()) THEN467 IF( .NOT. Agrif_Root() ) THEN 468 468 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 469 469 ENDIF -
branches/dev_005_AWL/NEMO/OPA_SRC/DYN/divcur.F90
r1152 r1804 123 123 124 124 #if defined key_obc 125 #if defined key_agrif 126 IF (Agrif_Root() ) THEN 127 #endif 128 ! open boundaries (div must be zero behind the open boundary) 129 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 130 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east 131 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west 132 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north 133 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 134 #if defined key_agrif 135 ENDIF 136 #endif 125 IF( Agrif_Root() ) THEN 126 ! open boundaries (div must be zero behind the open boundary) 127 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 128 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east 129 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west 130 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north 131 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 132 ENDIF 137 133 #endif 138 134 #if defined key_bdy 139 135 ! unstructured open boundaries (div must be zero behind the open boundary) 140 136 DO jj = 1, jpj 141 DO ji = 1, jpi142 hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj)143 END DO137 DO ji = 1, jpi 138 hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj) 139 END DO 144 140 END DO 145 141 #endif 146 #if defined key_agrif 147 if ( .NOT. AGRIF_Root() ) then 148 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east 149 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0 ! west 150 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0 ! north 151 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0 ! south 152 endif 153 #endif 142 IF( .NOT. AGRIF_Root() ) THEN 143 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east 144 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0 ! west 145 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0 ! north 146 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0 ! south 147 ENDIF 154 148 155 149 ! ! -------- … … 341 335 342 336 #if defined key_obc 343 #if defined key_agrif 344 IF ( Agrif_Root() ) THEN 345 #endif 346 ! open boundaries (div must be zero behind the open boundary) 347 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 348 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east 349 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west 350 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north 351 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 352 #if defined key_agrif 353 ENDIF 354 #endif 337 IF( Agrif_Root() ) THEN 338 ! open boundaries (div must be zero behind the open boundary) 339 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 340 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east 341 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west 342 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north 343 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south 344 ENDIF 355 345 #endif 356 346 #if defined key_bdy … … 362 352 END DO 363 353 #endif 364 #if defined key_agrif 365 if ( .NOT. AGRIF_Root() ) then 354 IF( .NOT. AGRIF_Root() ) THEN 366 355 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east 367 356 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0 ! west 368 357 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0 ! north 369 358 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0 ! south 370 endif 371 #endif 359 ENDIF 372 360 373 361 ! ! -------- -
branches/dev_005_AWL/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r1739 r1804 330 330 END DO 331 331 332 #if defined key_agrif 332 #if defined key_agrif 333 333 IF( .NOT. Agrif_Root() ) THEN 334 334 ! caution : grad D (fine) = grad D (coarse) at coarse/fine interface … … 338 338 IF( nbondj == 1 .OR. nbondj == 2 ) spgv(:,nlcj-2) = z2dtg * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1) 339 339 ENDIF 340 #endif 340 #endif 341 341 342 ! Add the trends multiplied by z2dt to the after velocity 342 343 ! ------------------------------------------------------- -
branches/dev_005_AWL/NEMO/OPA_SRC/DYN/sshwzv.F90
r1756 r1804 157 157 158 158 #if defined key_obc 159 # if defined key_agrif160 159 IF ( Agrif_Root() ) THEN 161 # endif162 160 ssha(:,:) = ssha(:,:) * obctmsk(:,:) 163 161 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 164 # if defined key_agrif 165 ENDIF 166 # endif 162 ENDIF 167 163 #endif 168 164 -
branches/dev_005_AWL/NEMO/OPA_SRC/IOM/iom.F90
r1743 r1804 43 43 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 44 44 #endif 45 PUBLIC iom_init, iom_ open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put45 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 46 46 47 47 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 86 86 !!---------------------------------------------------------------------- 87 87 ! read the xml file 88 CALL event__parse_xml_file( 'iodef.xml' ) ! <- to get from the nameliste (namrun)... 88 IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' ) ! <- to get from the nameliste (namrun)... 89 CALL iom_swap 89 90 90 91 ! calendar parameters … … 119 120 120 121 END SUBROUTINE iom_init 122 123 124 SUBROUTINE iom_swap 125 !!--------------------------------------------------------------------- 126 !! *** SUBROUTINE iom_swap *** 127 !! 128 !! ** Purpose : swap context between different agrif grid for xmlio_server 129 !!--------------------------------------------------------------------- 130 #if defined key_iomput 131 132 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 133 CALL event__swap_context("nemo") 134 ELSE 135 CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo") 136 ENDIF 137 138 #endif 139 END SUBROUTINE iom_swap 121 140 122 141 … … 164 183 ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0 165 184 ! (could be done when defining iom_file in f95 but not in f90) 166 #if ! defined key_agrif167 IF( iom_open_init == 0 ) THEN168 iom_file(:)%nfid = 0169 iom_open_init = 1170 ENDIF171 #else172 185 IF( Agrif_Root() ) THEN 173 186 IF( iom_open_init == 0 ) THEN … … 176 189 ENDIF 177 190 ENDIF 178 #endif179 191 ! do we read or write the file? 180 192 IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt … … 199 211 ! ============= 200 212 clname = trim(cdname) 201 #if defined key_agrif202 213 IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 203 214 iln = INDEX(clname,'/') … … 206 217 clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 207 218 ENDIF 208 #endif209 219 ! which suffix should we use? 210 220 SELECT CASE (iolib) -
branches/dev_005_AWL/NEMO/OPA_SRC/SBC/sbcmod.F90
r1790 r1804 86 86 !!gm here no overwrite, test all option via namelist change: require more incore memory 87 87 !!gm IF( lk_sbc_cpl ) THEN ; ln_cpl = .TRUE. ; ELSE ; ln_cpl = .FALSE. ; ENDIF 88 #if defined key_agrif 88 89 89 IF ( Agrif_Root() ) THEN 90 #endif91 90 IF( lk_lim2 ) nn_ice = 2 92 91 IF( lk_lim3 ) nn_ice = 3 93 #if defined key_agrif 94 ENDIF 95 #endif 92 ENDIF 93 ! 96 94 IF( cp_cfg == 'gyre' ) THEN 97 95 ln_ana = .TRUE. -
branches/dev_005_AWL/NEMO/OPA_SRC/SOL/solmat.F90
r1601 r1804 142 142 #endif 143 143 144 #if defined key_agrif 145 IF( .NOT.AGRIF_ROOT() ) THEN 144 IF( .NOT. Agrif_Root() ) THEN ! Fine grid boundaries 146 145 ! 147 146 IF( nbondi == -1 .OR. nbondi == 2 ) bmask(2 ,: ) = 0.e0 … … 192 191 ! 193 192 ENDIF 194 #endif195 193 196 194 ! 2. Boundary conditions -
branches/dev_005_AWL/NEMO/OPA_SRC/lib_mpp.F90
r1718 r1804 112 112 INTEGER :: mppsize ! number of process 113 113 INTEGER :: mpprank ! process number [ 0 - size-1 ] 114 INTEGER :: mpi_comm_opa ! opa local communicator 114 !$AGRIF_DO_NOT_TREAT 115 INTEGER, PUBLIC :: mpi_comm_opa ! opa local communicator 116 !$AGRIF_END_DO_NOT_TREAT 115 117 116 118 ! variables used in case of sea-ice … … 191 193 WRITE(ldtxt(6),*) ' size in bytes of exported buffer nn_buffer = ', nn_buffer 192 194 193 #if defined key_agrif 194 IF( Agrif_Root() ) THEN 195 #endif 196 !!bug RB : should be clean to use Agrif in coupled mode 197 #if ! defined key_agrif 198 CALL mpi_initialized ( mpi_was_called, code ) 199 IF( code /= MPI_SUCCESS ) THEN 200 WRITE(*, cform_err) 201 WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 202 CALL mpi_abort( mpi_comm_world, code, ierr ) 203 ENDIF 204 205 IF( PRESENT(localComm) .and. mpi_was_called ) THEN 206 mpi_comm_opa = localComm 207 SELECT CASE ( cn_mpi_send ) 208 CASE ( 'S' ) ! Standard mpi send (blocking) 209 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 210 CASE ( 'B' ) ! Buffer mpi send (blocking) 211 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 212 CALL mpi_init_opa( ierr ) 213 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 214 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 215 l_isend = .TRUE. 216 CASE DEFAULT 217 WRITE(ldtxt(7),cform_err) 218 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 219 nstop = nstop + 1 220 END SELECT 221 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 222 WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 223 WRITE(ldtxt(8),*) ' without calling MPI_Init before ! ' 224 nstop = nstop + 1 225 ELSE 226 #endif 227 SELECT CASE ( cn_mpi_send ) 228 CASE ( 'S' ) ! Standard mpi send (blocking) 229 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 230 CALL mpi_init( ierr ) 231 CASE ( 'B' ) ! Buffer mpi send (blocking) 232 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 233 CALL mpi_init_opa( ierr ) 234 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 235 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 236 l_isend = .TRUE. 237 CALL mpi_init( ierr ) 238 CASE DEFAULT 239 WRITE(ldtxt(7),cform_err) 240 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 241 nstop = nstop + 1 242 END SELECT 243 244 #if ! defined key_agrif 245 CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 246 IF( code /= MPI_SUCCESS ) THEN 247 WRITE(*, cform_err) 248 WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 249 CALL mpi_abort( mpi_comm_world, code, ierr ) 250 ENDIF 251 ! 252 ENDIF 253 #endif 254 #if defined key_agrif 255 ELSE 195 CALL mpi_initialized ( mpi_was_called, code ) 196 IF( code /= MPI_SUCCESS ) THEN 197 WRITE(*, cform_err) 198 WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 199 CALL mpi_abort( mpi_comm_world, code, ierr ) 200 ENDIF 201 202 IF( mpi_was_called ) THEN 203 ! 256 204 SELECT CASE ( cn_mpi_send ) 257 205 CASE ( 'S' ) ! Standard mpi send (blocking) … … 259 207 CASE ( 'B' ) ! Buffer mpi send (blocking) 260 208 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 209 CALL mpi_init_opa( ierr ) 261 210 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 262 211 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' … … 267 216 nstop = nstop + 1 268 217 END SELECT 218 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 219 WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 220 WRITE(ldtxt(8),*) ' without calling MPI_Init before ! ' 221 nstop = nstop + 1 222 ELSE 223 SELECT CASE ( cn_mpi_send ) 224 CASE ( 'S' ) ! Standard mpi send (blocking) 225 WRITE(ldtxt(7),*) ' Standard blocking mpi send (send)' 226 CALL mpi_init( ierr ) 227 CASE ( 'B' ) ! Buffer mpi send (blocking) 228 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 229 CALL mpi_init_opa( ierr ) 230 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 231 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' 232 l_isend = .TRUE. 233 CALL mpi_init( ierr ) 234 CASE DEFAULT 235 WRITE(ldtxt(7),cform_err) 236 WRITE(ldtxt(8),*) ' bad value for cn_mpi_send = ', cn_mpi_send 237 nstop = nstop + 1 238 END SELECT 239 ! 269 240 ENDIF 270 241 271 mpi_comm_opa = mpi_comm_world 272 #endif 242 IF( PRESENT(localComm) ) THEN 243 IF( Agrif_Root() ) THEN 244 mpi_comm_opa = localComm 245 ENDIF 246 ELSE 247 CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 248 IF( code /= MPI_SUCCESS ) THEN 249 WRITE(*, cform_err) 250 WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 251 CALL mpi_abort( mpi_comm_world, code, ierr ) 252 ENDIF 253 ENDIF 254 273 255 CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 274 256 CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) -
branches/dev_005_AWL/NEMO/OPA_SRC/opa.F90
r1725 r1804 156 156 CALL opa_closefile 157 157 #if defined key_oasis3 || defined key_oasis4 158 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 158 IF( Agrif_Root() ) THEN 159 CALL cpl_prism_finalize ! end coupling and mpp communications with OASIS 160 ENDIF 159 161 #else 160 162 IF( lk_mpp ) CALL mppstop ! end mpp communications … … 191 193 #if defined key_iomput 192 194 # if defined key_oasis3 || defined key_oasis4 193 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 194 CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it) 195 IF( Agrif_Root() ) THEN 196 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 197 CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it) 198 ENDIF 195 199 # else 196 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 200 IF( Agrif_Root() ) THEN 201 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 202 ENDIF 197 203 # endif 198 204 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection … … 200 206 #else 201 207 # if defined key_oasis3 || defined key_oasis4 202 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 208 IF( Agrif_Root() ) THEN 209 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 210 ENDIF 203 211 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt) 204 212 # else -
branches/dev_005_AWL/NEMO/OPA_SRC/step.F90
r1756 r1804 166 166 #if defined key_agrif 167 167 kstp = nit000 + Agrif_Nb_Step() 168 ! IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 169 ! IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 168 ! IF( Agrif_Root() .and. lwp) Write(*,*) '---' 169 ! IF(lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 170 # if defined key_iomput 171 IF( Agrif_Nbstepint() == 0) CALL iom_swap 172 # endif 170 173 #endif 171 174 indic = 1 ! reset to no error condition -
branches/dev_005_AWL/NEMO/TOP_SRC/C14b/trclsm_c14b.F90
r1581 r1804 44 44 INTEGER :: numnatb 45 45 46 #if defined key_trc_diaadd 46 #if defined key_trc_diaadd && ! defined key_iomput 47 47 ! definition of additional diagnostic as a structure 48 48 INTEGER :: jl, jn … … 58 58 !! 59 59 NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 60 #if defined key_trc_diaadd 60 #if defined key_trc_diaadd && ! defined key_iomput 61 61 NAMELIST/namc14dia/nwritedia, c14dia2d, c14dia3d ! additional diagnostics 62 62 #endif … … 81 81 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg_b = ', nyear_beg_b 82 82 ! 83 #if defined key_trc_diaadd 83 #if defined key_trc_diaadd && ! defined key_iomput 84 84 85 85 ! Namelist namc14dia -
branches/dev_005_AWL/NEMO/TOP_SRC/CFC/trcctl_cfc.F90
r1255 r1804 44 44 IF( jp_cfc > 2) THEN 45 45 IF(lwp) THEN 46 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 47 WRITE (numout,*) ' ======= ============= ' 46 WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 48 47 WRITE (numout,*) & 49 48 & ' STOP, change jp_cfc to 1 or 2 in par_CFC module ' … … 62 61 63 62 IF(lwp) THEN 64 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 65 WRITE (numout,*) ' ======= ============= ' 63 WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 66 64 WRITE (numout,*) ' we force tracer names' 67 65 DO jl = 1, jp_cfc … … 80 78 ctrcun(jn) = 'mole/m3' 81 79 IF(lwp) THEN 82 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 83 WRITE (numout,*) ' ======= ============= ' 80 WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 84 81 WRITE (numout,*) ' we force tracer unit' 85 82 WRITE(numout,*) ' tracer ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) -
branches/dev_005_AWL/NEMO/TOP_SRC/CFC/trclsm_cfc.F90
r1581 r1804 43 43 !!---------------------------------------------------------------------- 44 44 INTEGER :: numnatc 45 #if defined key_trc_diaadd 45 #if defined key_trc_diaadd && ! defined key_iomput 46 46 ! definition of additional diagnostic as a structure 47 47 INTEGER :: jl, jn … … 56 56 !! 57 57 NAMELIST/namcfcdate/ ndate_beg, nyear_res 58 #if defined key_trc_diaadd 58 #if defined key_trc_diaadd && ! defined key_iomput 59 59 NAMELIST/namcfcdia/nwritedia, cfcdia2d ! additional diagnostics 60 60 #endif … … 79 79 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg = ', nyear_beg 80 80 ! 81 #if defined key_trc_diaadd 81 #if defined key_trc_diaadd && ! defined key_iomput 82 82 83 83 ! Namelist namcfcdia -
branches/dev_005_AWL/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r1457 r1804 482 482 ENDIF 483 483 484 IF( l_trdtrc ) DEALLOCATE( ztrbio ) 485 484 486 IF(ln_ctl) THEN ! print mean trends (used for debugging) 485 487 WRITE(charout, FMT="('bio')") -
branches/dev_005_AWL/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r1457 r1804 164 164 ENDIF 165 165 166 IF( l_trdtrc ) DEALLOCATE( ztrbio ) 167 166 168 IF(ln_ctl) THEN ! print mean trends (used for debugging) 167 169 WRITE(charout, FMT="('exp')") -
branches/dev_005_AWL/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
r1542 r1804 26 26 PUBLIC trc_ini_lobster ! called by trcini.F90 module 27 27 28 # include "domzgr_substitute.h90"29 28 # include "top_substitute.h90" 30 29 !!---------------------------------------------------------------------- -
branches/dev_005_AWL/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r1445 r1804 28 28 29 29 !!* Substitution 30 # include " domzgr_substitute.h90"30 # include "top_substitute.h90" 31 31 !!---------------------------------------------------------------------- 32 32 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r1457 r1804 29 29 30 30 !!* Substitution 31 # include " domzgr_substitute.h90"31 # include "top_substitute.h90" 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) … … 136 136 ENDIF 137 137 138 IF( l_trdtrc ) DEALLOCATE( ztrbio ) 139 138 140 IF(ln_ctl) THEN ! print mean trends (used for debugging) 139 141 WRITE(charout, FMT="('sed')") -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zbio.F90
r1678 r1804 39 39 40 40 !!* Substitution 41 # include " domzgr_substitute.h90"41 # include "top_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zche.F90
r1180 r1804 147 147 148 148 !!* Substitution 149 #include " domzgr_substitute.h90"149 #include "top_substitute.h90" 150 150 !!---------------------------------------------------------------------- 151 151 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zflx.F90
r1737 r1804 52 52 53 53 !!* Substitution 54 # include " domzgr_substitute.h90"54 # include "top_substitute.h90" 55 55 !!---------------------------------------------------------------------- 56 56 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zlim.F90
r1152 r1804 41 41 42 42 !!* Substitution 43 # include " domzgr_substitute.h90"43 # include "top_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zmeso.F90
r1736 r1804 45 45 46 46 !!* Substitution 47 # include " domzgr_substitute.h90"47 # include "top_substitute.h90" 48 48 !!---------------------------------------------------------------------- 49 49 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zmicro.F90
r1736 r1804 43 43 44 44 !!* Substitution 45 # include " domzgr_substitute.h90"45 # include "top_substitute.h90" 46 46 !!---------------------------------------------------------------------- 47 47 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zmort.F90
r1736 r1804 41 41 42 42 !!* Substitution 43 # include " domzgr_substitute.h90"43 # include "top_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zopt.F90
r1678 r1804 35 35 36 36 !!* Substitution 37 # include " domzgr_substitute.h90"37 # include "top_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 39 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zprod.F90
r1736 r1804 53 53 54 54 !!* Substitution 55 # include " domzgr_substitute.h90"55 # include "top_substitute.h90" 56 56 !!---------------------------------------------------------------------- 57 57 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zrem.F90
r1744 r1804 45 45 46 46 !!* Substitution 47 # include " domzgr_substitute.h90"47 # include "top_substitute.h90" 48 48 !!---------------------------------------------------------------------- 49 49 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/p4zsink.F90
r1736 r1804 69 69 70 70 !!* Substitution 71 # include " domzgr_substitute.h90"71 # include "top_substitute.h90" 72 72 !!---------------------------------------------------------------------- 73 73 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r1678 r1804 38 38 LOGICAL :: ln_pisdmp !: relaxation or not of nutrients to a mean value 39 39 !: when initialize from a restart file 40 LOGICAL :: ln_pisclo !: Restoring or not of nutrients to initial value 41 !: on close seas 40 42 41 43 !!* Biological fluxes for light -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r1542 r1804 38 38 no3 = 31.04e-6 * 7.6 39 39 40 # include "domzgr_substitute.h90"41 40 # include "top_substitute.h90" 42 41 !!---------------------------------------------------------------------- -
branches/dev_005_AWL/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90
r1581 r1804 67 67 NAMELIST/nampisdia/ nwritedia, pisdia3d, pisdia2d ! additional diagnostics 68 68 #endif 69 NAMELIST/nampisdmp/ ln_pisdmp 69 NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo 70 70 71 71 !!---------------------------------------------------------------------- … … 188 188 WRITE(numout,*) 189 189 WRITE(numout,*) ' Namelist : nampisdmp' 190 WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp 190 WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp 191 WRITE(numout,*) ' Restoring of tracer to initial value on closed seas ln_pisclo =', ln_pisclo 191 192 WRITE(numout,*) ' ' 192 193 ENDIF -
branches/dev_005_AWL/NEMO/TOP_SRC/TRP/trctrp.F90
r1445 r1804 53 53 54 54 !! * Substitutions 55 # include " domzgr_substitute.h90"55 # include "top_substitute.h90" 56 56 !!---------------------------------------------------------------------- 57 57 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) -
branches/dev_005_AWL/NEMO/TOP_SRC/TRP/trczdf_imp.F90
r1271 r1804 112 112 rdttrc(:) = rdttra(:) * FLOAT(ndttrc) 113 113 ENDIF 114 ! ! =========== 114 115 ! Initialisation 116 zwd( 1 ,:,:) = 0.e0 ; zwd(jpi,:,:) = 0.e0 117 zws( 1 ,:,:) = 0.e0 ; zws(jpi,:,:) = 0.e0 118 zwi( 1 ,:,:) = 0.e0 ; zwi(jpi,:,:) = 0.e0 119 ! 120 ! 0. Matrix construction 121 ! ---------------------- 122 123 ! Diagonal, inferior, superior 124 ! (including the bottom boundary condition via avs masked 125 DO jk = 1, jpkm1 126 DO jj = 2, jpjm1 127 DO ji = fs_2, fs_jpim1 ! vector opt. 128 zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk ) ) 129 zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 130 zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 131 END DO 132 END DO 133 END DO 134 135 ! Surface boudary conditions 136 DO jj = 2, jpjm1 137 DO ji = fs_2, fs_jpim1 138 zwi(ji,jj,1) = 0.e0 139 zwd(ji,jj,1) = 1. - zws(ji,jj,1) 140 END DO 141 END DO 142 143 ! ! =========== 115 144 DO jn = 1, jptra ! tracer loop 116 145 ! ! =========== 117 146 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! ??? validation needed 118 147 119 ! Initialisation120 zwd( 1 ,:,:) = 0.e0 ; zwd(jpi,:,:) = 0.e0121 zws( 1 ,:,:) = 0.e0 ; zws(jpi,:,:) = 0.e0122 zwi( 1 ,:,:) = 0.e0 ; zwi(jpi,:,:) = 0.e0123 148 zwt( 1 ,:,:) = 0.e0 ; zwt(jpi,:,:) = 0.e0 124 149 zwt( :,:,1) = 0.e0 ; zwt( :,:,jpk) = 0.e0 125 !126 ! 0. Matrix construction127 ! ----------------------128 129 ! Diagonal, inferior, superior130 ! (including the bottom boundary condition via avs masked131 DO jk = 1, jpkm1132 DO jj = 2, jpjm1133 DO ji = fs_2, fs_jpim1 ! vector opt.134 zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk ) )135 zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )136 zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk)137 END DO138 END DO139 END DO140 141 ! Surface boudary conditions142 DO jj = 2, jpjm1143 DO ji = fs_2, fs_jpim1144 zwi(ji,jj,1) = 0.e0145 zwd(ji,jj,1) = 1. - zws(ji,jj,1)146 END DO147 END DO148 150 149 151 ! Second member construction -
branches/dev_005_AWL/NEMO/TOP_SRC/TRP/trczdf_iso.F90
r1271 r1804 182 182 183 183 184 185 DO jn = 1, jptra 184 ! 0.2 Update and save of avt (and avs if double diffusive mixing) 185 ! --------------------------- 186 187 DO jj = 2, jpjm1 ! Vertical slab 188 ! ! =============== 189 DO jk = 2, jpkm1 190 DO ji = 2, jpim1 191 zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk) & 192 & +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) ) 193 ! add isopycnal vertical coeff. to avs 194 fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi 195 END DO 196 END DO 197 ! 198 END DO 199 200 201 202 DO jn = 1, jptra 186 203 187 204 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends … … 262 279 END DO 263 280 264 265 ! I.3 update and save of avt (and avs if double diffusive mixing)266 ! ---------------------------267 268 DO jk = 2, jpkm1269 DO ji = 2, jpim1270 271 zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk) &272 & +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) )273 274 ! add isopycnal vertical coeff. to avs275 fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi276 277 END DO278 END DO279 281 280 282 #if defined key_trcldf_eiv -
branches/dev_005_AWL/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90
r1328 r1804 154 154 zws => va ! workspace 155 155 INTEGER, INTENT( in ) :: kt ! ocean time-step index 156 INTEGER :: ji, jj, jk, jn ! dummy loop indices156 INTEGER :: ji, jj, jk, jn ! dummy loop indices 157 157 REAL(wp) :: zavi, zrhs ! temporary scalars 158 158 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & … … 180 180 ENDIF 181 181 182 183 zwd ( 1, :, : ) = 0.e0 ; zwd ( jpi, :, : ) = 0.e0 184 zws ( 1, :, : ) = 0.e0 ; zws ( jpi, :, : ) = 0.e0 185 zwi ( 1, :, : ) = 0.e0 ; zwi ( jpi, :, : ) = 0.e0 186 zwt ( 1, :, : ) = 0.e0 ; zwt ( jpi, :, : ) = 0.e0 187 zwt ( :, :, 1 ) = 0.e0 ; zwt ( :, :, jpk ) = 0.e0 188 zavsi( 1, :, : ) = 0.e0 ; zavsi( jpi, :, : ) = 0.e0 189 zavsi( :, :, 1 ) = 0.e0 ; zavsi( :, :, jpk ) = 0.e0 190 191 192 ! II. Vertical trend associated with the vertical physics 193 !======================================================= 194 ! (including the vertical flux proportional to dk[t] associated 195 ! with the lateral mixing, through the avt update) 196 ! dk[ avt dk[ (t,s) ] ] diffusive trends 197 198 ! II.0 Matrix construction 199 ! ------------------------ 200 ! update and save of avt (and avs if double diffusive mixing) 201 DO jk = 2, jpkm1 202 DO jj = 2, jpjm1 203 DO ji = fs_2, fs_jpim1 ! vector opt. 204 zavi = fsahtw(ji,jj,jk) * ( & ! vertical mixing coef. due to lateral mixing 205 & wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 206 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) 207 zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi ! dd mixing: zavsi = total vertical mixing coef. on tracer 208 END DO 209 END DO 210 END DO 211 212 ! II.1 Vertical diffusion on tracer 213 ! --------------------------------- 214 ! Rebuild the Matrix as avt /= avs 215 216 ! Diagonal, inferior, superior (including the bottom boundary condition via avs masked) 217 DO jk = 1, jpkm1 218 DO jj = 2, jpjm1 219 DO ji = fs_2, fs_jpim1 ! vector opt. 220 zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk ) ) 221 zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 222 zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 223 END DO 224 END DO 225 END DO 226 227 ! Surface boudary conditions 228 DO jj = 2, jpjm1 229 DO ji = fs_2, fs_jpim1 ! vector opt. 230 zwi(ji,jj,1) = 0.e0 231 zwd(ji,jj,1) = 1. - zws(ji,jj,1) 232 END DO 233 END DO 234 235 !! Matrix inversion from the first level 236 !!---------------------------------------------------------------------- 237 ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk ) 238 ! 239 ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 ) 240 ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 ) 241 ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 ) 242 ! ( ... )( ... ) ( ... ) 243 ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk ) 244 ! 245 ! m is decomposed in the product of an upper and lower triangular 246 ! matrix 247 ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 248 ! The second member is in 2d array zwy 249 ! The solution is in 2d array zwx 250 ! The 3d arry zwt is a work space array 251 ! zwy is used and then used as a work space array : its value is modified! 252 253 ! first recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 254 DO jj = 2, jpjm1 255 DO ji = fs_2, fs_jpim1 256 zwt(ji,jj,1) = zwd(ji,jj,1) 257 END DO 258 END DO 259 DO jk = 2, jpkm1 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 262 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)/zwt(ji,jj,jk-1) 263 END DO 264 END DO 265 END DO 266 182 267 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 183 268 … … 187 272 188 273 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 189 190 zwd ( 1, :, : ) = 0.e0 ; zwd ( jpi, :, : ) = 0.e0191 zws ( 1, :, : ) = 0.e0 ; zws ( jpi, :, : ) = 0.e0192 zwi ( 1, :, : ) = 0.e0 ; zwi ( jpi, :, : ) = 0.e0193 zwt ( 1, :, : ) = 0.e0 ; zwt ( jpi, :, : ) = 0.e0194 zwt ( :, :, 1 ) = 0.e0 ; zwt ( :, :, jpk ) = 0.e0195 zavsi( 1, :, : ) = 0.e0 ; zavsi( jpi, :, : ) = 0.e0196 zavsi( :, :, 1 ) = 0.e0 ; zavsi( :, :, jpk ) = 0.e0197 274 198 275 # if defined key_trc_diatrd … … 200 277 ztrd(:,:,:) = tra(:,:,:,jn) 201 278 # endif 202 203 ! II. Vertical trend associated with the vertical physics204 ! =======================================================205 ! (including the vertical flux proportional to dk[t] associated206 ! with the lateral mixing, through the avt update)207 ! dk[ avt dk[ (t,s) ] ] diffusive trends208 209 210 ! II.0 Matrix construction211 ! ------------------------212 ! update and save of avt (and avs if double diffusive mixing)213 DO jk = 2, jpkm1214 DO jj = 2, jpjm1215 DO ji = fs_2, fs_jpim1 ! vector opt.216 zavi = fsahtw(ji,jj,jk) * ( & ! vertical mixing coef. due to lateral mixing217 & wslpi(ji,jj,jk) * wslpi(ji,jj,jk) &218 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) )219 zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi ! dd mixing: zavsi = total vertical mixing coef. on tracer220 221 END DO222 END DO223 END DO224 225 226 ! II.1 Vertical diffusion on tracer227 ! ---------------------------------228 229 ! Rebuild the Matrix as avt /= avs230 231 ! Diagonal, inferior, superior (including the bottom boundary condition via avs masked)232 DO jk = 1, jpkm1233 DO jj = 2, jpjm1234 DO ji = fs_2, fs_jpim1 ! vector opt.235 zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk ) )236 zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )237 zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk)238 END DO239 END DO240 END DO241 242 ! Surface boudary conditions243 DO jj = 2, jpjm1244 DO ji = fs_2, fs_jpim1 ! vector opt.245 zwi(ji,jj,1) = 0.e0246 zwd(ji,jj,1) = 1. - zws(ji,jj,1)247 END DO248 END DO249 250 !! Matrix inversion from the first level251 !!----------------------------------------------------------------------252 ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk )253 !254 ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 )255 ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 )256 ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 )257 ! ( ... )( ... ) ( ... )258 ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk )259 !260 ! m is decomposed in the product of an upper and lower triangular261 ! matrix262 ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi263 ! The second member is in 2d array zwy264 ! The solution is in 2d array zwx265 ! The 3d arry zwt is a work space array266 ! zwy is used and then used as a work space array : its value is modified!267 268 ! first recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k)269 DO jj = 2, jpjm1270 DO ji = fs_2, fs_jpim1271 zwt(ji,jj,1) = zwd(ji,jj,1)272 END DO273 END DO274 DO jk = 2, jpkm1275 DO jj = 2, jpjm1276 DO ji = fs_2, fs_jpim1277 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)278 END DO279 END DO280 END DO281 279 282 280 ! second recurrence: Zk = Yk - Ik / Tk-1 Zk-1 -
branches/dev_005_AWL/NEMO/TOP_SRC/trcdta.F90
r1645 r1804 25 25 PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90 26 26 27 LOGICAL , PUBLIC, PARAMETER :: lk_dtatrc = .TRUE. !: temperature data flag 27 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) :: trdta !: tracer data at given time-step 28 29 … … 62 63 !! 63 64 CHARACTER (len=39) :: clname(jptra) 64 INTEGER, PARAMETER :: jpmois = 12 ! number of months 65 INTEGER, PARAMETER :: & 66 jpmonth = 12 ! number of months 65 67 INTEGER :: ji, jj, jn, jl 66 68 INTEGER :: imois, iman, i15, ik ! temporary integers … … 81 83 ENDIF 82 84 ! Initialization 83 iman = jpmo is85 iman = jpmonth 84 86 i15 = nday / 16 85 87 imois = nmonth + i15 -1 … … 188 190 ! Read init file only 189 191 IF( kt == nittrc000 ) THEN 192 ntrc1(jn) = 1 190 193 CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 191 194 trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) … … 204 207 !! Dummy module NO 3D passive tracer data 205 208 !!---------------------------------------------------------------------- 209 LOGICAL , PUBLIC, PARAMETER :: lk_dtatrc = .FALSE. !: temperature data flag 206 210 CONTAINS 207 211 SUBROUTINE trc_dta( kt ) ! Empty routine -
branches/dev_005_AWL/NEMO/TOP_SRC/trcrst.F90
r1655 r1804 1 1 MODULE trcrst 2 2 !!====================================================================== 3 !! *** MODULE trcrst ***4 !! TOP : create, write, read the restart files for passive tracers3 !! *** MODULE trcrst *** 4 !! TOP : Manage the passive tracer restart 5 5 !!====================================================================== 6 !! History : 1.0 ! 2007-02 (C. Ethe) adaptation from the ocean 6 !! History : - ! 1991-03 () original code 7 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 8 !! - ! 2005-10 (C. Ethe) print control 9 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture 7 10 !!---------------------------------------------------------------------- 8 11 #if defined key_top 12 !!---------------------------------------------------------------------- 13 !! 'key_top' TOP models 14 !!---------------------------------------------------------------------- 15 !!---------------------------------------------------------------------- 16 !! trc_rst : Restart for passive tracer 17 !!---------------------------------------------------------------------- 9 18 !!---------------------------------------------------------------------- 10 19 !! 'key_top' TOP models … … 16 25 USE oce_trc 17 26 USE trc 18 USE sms_lobster ! LOBSTER variables 19 USE sms_pisces ! PISCES variables 20 USE trcsms_cfc ! CFC variables 21 USE trcsms_c14b ! C14 variables 22 USE trcsms_my_trc ! MY_TRC variables 23 USE trctrp_lec 27 USE trctrp_lec 24 28 USE lib_mpp 25 29 USE iom 26 30 USE trcrst_cfc ! CFC 31 USE trcrst_lobster ! LOBSTER restart 32 USE trcrst_pisces ! PISCES restart 33 USE trcrst_c14b ! C14 bomb restart 34 USE trcrst_my_trc ! MY_TRC restart 35 27 36 IMPLICIT NONE 28 37 PRIVATE 29 38 30 39 PUBLIC trc_rst_opn ! called by ??? 31 40 PUBLIC trc_rst_read ! called by ??? 32 41 PUBLIC trc_rst_wri ! called by ??? 33 42 34 43 INTEGER, PUBLIC :: numrtr, numrtw !: logical unit for trc restart (read and write) 35 36 44 37 45 !! * Substitutions … … 89 97 END SUBROUTINE trc_rst_opn 90 98 91 92 SUBROUTINE trc_rst_read 99 SUBROUTINE trc_rst_read 93 100 !!---------------------------------------------------------------------- 94 101 !! *** trc_rst_opn *** … … 96 103 !! ** purpose : read passive tracer fields in restart files 97 104 !!---------------------------------------------------------------------- 98 INTEGER :: jn 99 INTEGER :: iarak0 105 INTEGER :: jn 106 INTEGER :: iarak0 100 107 REAL(wp) :: zarak0 101 108 INTEGER :: jlibalt = jprstlib 102 109 LOGICAL :: llok 103 #if defined key_pisces104 INTEGER :: ji, jj, jk105 REAL(wp) :: zcaralk, zbicarb, zco3106 REAL(wp) :: ztmas, ztmas1107 #endif108 110 109 111 !!---------------------------------------------------------------------- … … 115 117 IF ( jprstlib == jprstdimg ) THEN 116 118 ! eventually read netcdf file (monobloc) for restarting on different number of processors 117 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 119 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 118 120 INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 119 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 120 ENDIF 121 122 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 121 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 122 ENDIF 123 124 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 123 125 124 126 ! Time domain : restart … … 136 138 & ' centered or euler ' ) 137 139 IF(lwp) WRITE(numout,*) 138 139 140 IF(lwp) WRITE(numout,*) ' arakawa option : ', NINT( zarak0 ) 140 141 141 142 142 ! READ prognostic variables and computes diagnostic variable 143 143 DO jn = 1, jptra 144 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 145 END DO 146 147 DO jn = 1, jptra 148 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 149 END DO 150 151 #if defined key_lobster 152 CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 153 CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 154 #endif 155 #if defined key_pisces 156 ! 157 IF( ln_pisdmp ) CALL pis_dmp_ini ! relaxation of some tracers 158 ! 159 IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 160 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 161 ELSE 162 ! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???) 163 ! -------------------------------------------------------- 164 DO jk = 1, jpk 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 ztmas = tmask(ji,jj,jk) 168 ztmas1 = 1. - tmask(ji,jj,jk) 169 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 170 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 171 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 172 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 173 END DO 174 END DO 175 END DO 176 ENDIF 177 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 178 IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 179 CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:) ) 180 ELSE 181 xksimax(:,:) = xksi(:,:) 182 ENDIF 183 #endif 184 #if defined key_cfc 185 DO jn = jp_cfc0, jp_cfc1 186 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 187 END DO 188 #endif 189 #if defined key_c14b 190 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn) , qint_c14(:,:) ) 191 #endif 192 #if defined key_my_trc 193 #endif 194 144 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 145 END DO 146 147 DO jn = 1, jptra 148 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 149 END DO 150 151 IF( lk_lobster ) CALL trc_rst_read_lobster( numrtr ) ! LOBSTER bio-model 152 IF( lk_pisces ) CALL trc_rst_read_pisces ( numrtr ) ! PISCES bio-model 153 IF( lk_cfc ) CALL trc_rst_read_cfc ( numrtr ) ! CFC tracers 154 IF( lk_c14b ) CALL trc_rst_read_c14b ( numrtr ) ! C14 bomb tracer 155 IF( lk_my_trc ) CALL trc_rst_read_my_trc ( numrtr ) ! MY_TRC tracers 156 195 157 CALL iom_close( numrtr ) 196 158 ! 197 159 END SUBROUTINE trc_rst_read 198 199 160 200 161 SUBROUTINE trc_rst_wri( kt ) … … 218 179 CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 219 180 220 ! prognostic variables 221 ! -------------------- 181 ! prognostic variables 182 ! -------------------- 222 183 DO jn = 1, jptra 223 184 CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) … … 228 189 END DO 229 190 230 #if defined key_lobster 231 CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 232 CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 233 #endif 234 #if defined key_pisces 235 CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) ) 236 CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 237 CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 238 #endif 239 #if defined key_cfc 240 DO jn = jp_cfc0, jp_cfc1 241 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 242 END DO 243 #endif 244 #if defined key_c14b 245 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_c14(:,:) ) 246 #endif 247 #if defined key_my_trc 248 #endif 249 191 IF( lk_lobster ) CALL trc_rst_wri_lobster( kt, nitrst, numrtw ) ! LOBSTER bio-model 192 IF( lk_pisces ) CALL trc_rst_wri_pisces ( kt, nitrst, numrtw ) ! PISCES bio-model 193 IF( lk_cfc ) CALL trc_rst_wri_cfc ( kt, nitrst, numrtw ) ! CFC tracers 194 IF( lk_c14b ) CALL trc_rst_wri_c14b ( kt, nitrst, numrtw ) ! C14 bomb tracer 195 IF( lk_my_trc ) CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw ) ! MY_TRC tracers 196 250 197 IF( kt == nitrst ) THEN 251 198 CALL trc_rst_stat ! statistics … … 256 203 ENDIF 257 204 ! 258 END SUBROUTINE trc_rst_wri 205 END SUBROUTINE trc_rst_wri 206 259 207 260 208 SUBROUTINE trc_rst_cal( kt, cdrw ) … … 347 295 END SUBROUTINE trc_rst_cal 348 296 349 # if defined key_pisces350 351 SUBROUTINE pis_dmp_ini352 !!----------------------------------------------------------------------353 !! *** pis_dmp_ini ***354 !!355 !! ** purpose : Relaxation of some tracers356 !!----------------------------------------------------------------------357 INTEGER :: ji, jj, jk358 REAL(wp) :: &359 alkmean = 2426. , & ! mean value of alkalinity ( Glodap ; for Goyet 2391. )360 po4mean = 2.165 , & ! mean value of phosphates361 no3mean = 30.90 , & ! mean value of nitrate362 siomean = 91.51 ! mean value of silicate363 364 REAL(wp) :: zvol, ztrasum365 366 367 IF(lwp) WRITE(numout,*)368 369 IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN ! ORCA condiguration (not 1D) !370 ! ! --------------------------- !371 ! set total alkalinity, phosphate, NO3 & silicate372 373 ! total alkalinity374 ztrasum = 0.e0375 DO jk = 1, jpk376 DO jj = 1, jpj377 DO ji = 1, jpi378 zvol = cvol(ji,jj,jk)379 # if defined key_off_degrad380 zvol = zvol * facvol(ji,jj,jk)381 # endif382 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * zvol383 END DO384 END DO385 END DO386 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain387 388 ztrasum = ztrasum / areatot * 1.e6389 IF(lwp) WRITE(numout,*) ' TALK mean : ', ztrasum390 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum391 392 ! phosphate393 ztrasum = 0.e0394 DO jk = 1, jpk395 DO jj = 1, jpj396 DO ji = 1, jpi397 zvol = cvol(ji,jj,jk)398 # if defined key_off_degrad399 zvol = zvol * facvol(ji,jj,jk)400 # endif401 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * zvol402 END DO403 END DO404 END DO405 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain406 407 ztrasum = ztrasum / areatot * 1.e6 / 122.408 IF(lwp) WRITE(numout,*) ' PO4 mean : ', ztrasum409 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum410 411 ! Nitrates412 ztrasum = 0.e0413 DO jk = 1, jpk414 DO jj = 1, jpj415 DO ji = 1, jpi416 zvol = cvol(ji,jj,jk)417 # if defined key_off_degrad418 zvol = zvol * facvol(ji,jj,jk)419 # endif420 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * zvol421 END DO422 END DO423 END DO424 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain425 426 ztrasum = ztrasum / areatot * 1.e6 / 7.6427 IF(lwp) WRITE(numout,*) ' NO3 mean : ', ztrasum428 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum429 430 ! Silicate431 ztrasum = 0.e0432 DO jk = 1, jpk433 DO jj = 1, jpj434 DO ji = 1, jpi435 zvol = cvol(ji,jj,jk)436 # if defined key_off_degrad437 zvol = zvol * facvol(ji,jj,jk)438 # endif439 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * zvol440 END DO441 END DO442 END DO443 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain444 ztrasum = ztrasum / areatot * 1.e6445 IF(lwp) WRITE(numout,*) ' SiO3 mean : ', ztrasum446 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )447 !448 ENDIF449 450 !#if defined key_kriest451 ! !! Initialize number of particles from a standart restart file452 ! !! The name of big organic particles jpgoc has been only change453 ! !! and replace by jpnum but the values here are concentration454 ! trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)455 ! trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp )456 !#endif457 458 END SUBROUTINE pis_dmp_ini459 460 #endif461 !!----------------------------------------------------------------------462 297 463 298 SUBROUTINE trc_rst_stat
Note: See TracChangeset
for help on using the changeset viewer.
