Changeset 7 for trunk/libf/dyn3dpar
- Timestamp:
- Oct 28, 2010, 9:30:04 AM (15 years ago)
- Location:
- trunk/libf/dyn3dpar
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/libf/dyn3dpar/addfi_p.F
r1 r7 1 1 ! 2 ! $ Header$2 ! $Id: addfi_p.F 1446 2010-10-22 09:27:25Z emillour $ 3 3 ! 4 4 SUBROUTINE addfi_p(pdt, leapf, forward, … … 7 7 USE parallel 8 8 USE infotrac, ONLY : nqtot 9 USE control_mod, ONLY : planet_type 9 10 IMPLICIT NONE 10 11 c … … 154 155 c$OMP END MASTER 155 156 156 DO iq = 1, 2 157 if (planet_type=="earth") then 158 ! earth case, special treatment for first 2 tracers (water) 159 DO iq = 1, 2 157 160 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 158 161 DO k = 1,llm … … 163 166 ENDDO 164 167 c$OMP END DO NOWAIT 165 ENDDO166 167 DO iq = 3, nqtot168 ENDDO 169 170 DO iq = 3, nqtot 168 171 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 169 172 DO k = 1,llm … … 174 177 ENDDO 175 178 c$OMP END DO NOWAIT 176 ENDDO 179 ENDDO 180 else 181 ! general case, treat all tracers equally) 182 DO iq = 1, nqtot 183 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 184 DO k = 1,llm 185 DO j = ijb,ije 186 pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt 187 pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt ) 188 ENDDO 189 ENDDO 190 c$OMP END DO NOWAIT 191 ENDDO 192 endif ! of if (planet_type=="earth") 177 193 178 194 c$OMP MASTER -
trunk/libf/dyn3dpar/advtrac_p.F
r1 r7 1 1 ! 2 ! $Id: advtrac_p.F 14 03 2010-07-01 09:02:53Z fairhead$2 ! $Id: advtrac_p.F 1446 2010-10-22 09:27:25Z emillour $ 3 3 ! 4 4 c … … 132 132 ccc CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 ) 133 133 c 134 ENDIF 134 ENDIF ! of IF(iadvtr.EQ.0) 135 135 136 136 iadvtr = iadvtr+1 … … 266 266 cym ----> Revérifier lors de la parallélisation des autres schemas 267 267 268 cym call massbar_p(massem,massebx,masseby) 268 cym call massbar_p(massem,massebx,masseby) 269 269 270 270 call vlspltgen_p( q,iadv, 2., massem, wg , … … 452 452 c$OMP BARRIER 453 453 454 ijb=ij_begin 455 ije=ij_end 454 if (planet_type=="earth") then 455 456 ijb=ij_begin 457 ije=ij_end 456 458 457 459 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 458 DO l = 1, llm460 DO l = 1, llm 459 461 DO ij = ijb, ije 460 462 finmasse(ij,l) = p(ij,l) - p(ij,l+1) 461 463 ENDDO 462 ENDDO464 ENDDO 463 465 c$OMP END DO 464 466 465 CALL qminimum_p( q, 2, finmasse )467 CALL qminimum_p( q, 2, finmasse ) 466 468 467 469 c------------------------------------------------------------------ … … 496 498 c$OMP BARRIER 497 499 iadvtr=0 500 endif ! of if (planet_type=="earth") 498 501 ENDIF ! if iadvtr.EQ.iapp_tracvl 499 502 -
trunk/libf/dyn3dpar/caladvtrac_p.F
r1 r7 1 1 ! 2 ! $Id: caladvtrac_p.F 14 03 2010-07-01 09:02:53Z fairhead$2 ! $Id: caladvtrac_p.F 1446 2010-10-22 09:27:25Z emillour $ 3 3 ! 4 4 c … … 8 8 * flxw, pk, iapptrac) 9 9 USE parallel 10 USE infotrac 11 USE control_mod 10 USE infotrac, ONLY : nqtot 11 USE control_mod, ONLY : iapp_tracvl,planet_type 12 12 c 13 13 IMPLICIT NONE … … 30 30 c ---------- 31 31 REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm) 32 REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot),dq( ip1jmp1,llm,2 ) 32 REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot) 33 real :: dq( ip1jmp1,llm,nqtot) 33 34 REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm) 34 35 REAL :: flxw(ip1jmp1,llm) -
trunk/libf/dyn3dpar/conf_gcm.F
r1 r7 1 1 ! 2 ! $Id: conf_gcm.F 14 03 2010-07-01 09:02:53Z fairhead$2 ! $Id: conf_gcm.F 1438 2010-10-08 10:19:34Z jghattas $ 3 3 ! 4 4 c … … 578 578 offline = .FALSE. 579 579 CALL getin('offline',offline) 580 580 IF (offline .AND. adjust) THEN 581 WRITE(lunout,*) 582 & 'WARNING : option offline does not work with adjust=y :' 583 WRITE(lunout,*) 'the files defstoke.nc, fluxstoke.nc ', 584 & 'and fluxstokev.nc will not be created' 585 WRITE(lunout,*) 586 & 'only the file phystoke.nc will still be created ' 587 END IF 588 581 589 !Config Key = config_inca 582 590 !Config Desc = Choix de configuration de INCA … … 768 776 offline = .FALSE. 769 777 CALL getin('offline',offline) 778 IF (offline .AND. adjust) THEN 779 WRITE(lunout,*) 780 & 'WARNING : option offline does not work with adjust=y :' 781 WRITE(lunout,*) 'the files defstoke.nc, fluxstoke.nc ', 782 & 'and fluxstokev.nc will not be created' 783 WRITE(lunout,*) 784 & 'only the file phystoke.nc will still be created ' 785 END IF 770 786 771 787 !Config Key = config_inca -
trunk/libf/dyn3dpar/ener.h
r1 r7 1 1 ! 2 ! $ Header$2 ! $Id: ener.h 1447 2010-10-22 16:18:27Z jghattas $ 3 3 ! 4 c----------------------------------------------------------------------- 5 c INCLUDE 'ener.h' 4 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre 5 ! veillez à n'utiliser que des ! pour les commentaires 6 ! et à bien positionner les & des lignes de continuation 7 ! (les placer en colonne 6 et en colonne 73) 8 ! 9 ! INCLUDE 'ener.h' 6 10 7 COMMON/ener/ang0,etot0,ptot0,ztot0,stot0, 8 * ang,etot,ptot,ztot,stot,rmsdpdt ,9 *rmsv,gtot(llmm1)11 COMMON/ener/ang0,etot0,ptot0,ztot0,stot0, & 12 & ang,etot,ptot,ztot,stot,rmsdpdt , & 13 & rmsv,gtot(llmm1) 10 14 11 REAL ang0,etot0,ptot0,ztot0,stot0, 12 sang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot15 REAL ang0,etot0,ptot0,ztot0,stot0, & 16 & ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot 13 17 14 c-----------------------------------------------------------------------18 !----------------------------------------------------------------------- -
trunk/libf/dyn3dpar/gcm.F
r1 r7 1 1 ! 2 ! $Id: gcm.F 14 03 2010-07-01 09:02:53Z fairhead$2 ! $Id: gcm.F 1446 2010-10-22 09:27:25Z emillour $ 3 3 ! 4 4 c … … 276 276 endif 277 277 278 if (planet_type.eq."earth") then 279 #ifdef CPP_EARTH 278 ! if (planet_type.eq."earth") then 280 279 ! Load an Earth-format start file 281 280 CALL dynetat0("start.nc",vcov,ucov, 282 281 & teta,q,masse,ps,phis, time_0) 283 #else 284 ! SW model also has Earth-format start files 285 ! (but can be used without the CPP_EARTH directive) 286 if (iflag_phys.eq.0) then 287 CALL dynetat0("start.nc",vcov,ucov, 288 & teta,q,masse,ps,phis, time_0) 289 endif 290 #endif 291 endif ! of if (planet_type.eq."earth") 282 ! endif ! of if (planet_type.eq."earth") 283 292 284 c write(73,*) 'ucov',ucov 293 285 c write(74,*) 'vcov',vcov … … 494 486 #endif 495 487 496 if (planet_type.eq."earth") then 488 ! if (planet_type.eq."earth") then 489 ! Write an Earth-format restart file 497 490 CALL dynredem0_p("restart.nc", day_end, phis) 498 endif491 ! endif 499 492 500 493 ecripar = .TRUE. -
trunk/libf/dyn3dpar/grid_noro.F
r1 r7 1 1 ! 2 ! $Id: grid_noro.F 14 03 2010-07-01 09:02:53Z fairhead$2 ! $Id: grid_noro.F 1442 2010-10-18 08:31:31Z jghattas $ 3 3 ! 4 4 c … … 458 458 C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS 459 459 460 PARAMETER (ISMo=300,JSMo=200) 461 REAL X(IMAR,JMAR),XF(ISMo,JSMo) 460 REAL X(IMAR,JMAR),XF(IMAR,JMAR) 462 461 real WEIGHTpb(-1:1,-1:1) 463 462 464 if(imar.gt.ismo) stop'surdimensionner ismo dans mva9 (grid_noro)'465 if(jmar.gt.jsmo) stop'surdimensionner jsmo dans mva9 (grid_noro)'466 463 467 464 SUM=0. -
trunk/libf/dyn3dpar/infotrac.F90
r1 r7 61 61 CHARACTER(len=1), DIMENSION(3) :: txts 62 62 CHARACTER(len=2), DIMENSION(9) :: txtp 63 CHARACTER(len= 13) :: str1,str263 CHARACTER(len=23) :: str1,str2 64 64 65 65 INTEGER :: nqtrue ! number of tracers read from tracer.def, without higer order of moment 66 66 INTEGER :: iq, new_iq, iiq, jq, ierr 67 INTEGER, EXTERNAL :: lnblnk 68 67 68 character(len=*),parameter :: modname="infotrac_init" 69 69 !----------------------------------------------------------------------- 70 70 ! Initialization : … … 100 100 OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr) 101 101 IF(ierr.EQ.0) THEN 102 WRITE(lunout,*) 'Open traceur.def : ok'102 WRITE(lunout,*) trim(modname),': Open traceur.def : ok' 103 103 READ(90,*) nqtrue 104 104 ELSE 105 WRITE(lunout,*) 'Problem in opening traceur.def'106 WRITE(lunout,*) 'ATTENTIONusing defaut values'105 WRITE(lunout,*) trim(modname),': Problem in opening traceur.def' 106 WRITE(lunout,*) trim(modname),': WARNING using defaut values' 107 107 nqtrue=4 ! Defaut value 108 108 END IF 109 ! Attention! Only for planet_type=='earth' 110 nbtr=nqtrue-2 109 if ( planet_type=='earth') then 110 ! For Earth, water vapour & liquid tracers are not in the physics 111 nbtr=nqtrue-2 112 else 113 ! Other planets (for now); we have the same number of tracers 114 ! in the dynamics than in the physics 115 nbtr=nqtrue 116 endif 111 117 ELSE 112 118 ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F … … 114 120 END IF 115 121 116 IF ( nqtrue < 2) THEN117 WRITE(lunout,*) 'nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'122 IF ((planet_type=="earth").and.(nqtrue < 2)) THEN 123 WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum' 118 124 CALL abort_gcm('infotrac_init','Not enough tracers',1) 119 125 END IF … … 159 165 END DO 160 166 CLOSE(90) 161 ELSE ! Without tracer.def 167 ELSE ! Without tracer.def, set default values (for Earth!) 168 if ((nqtrue==4).and.(planet_type=="earth")) then 162 169 hadv(1) = 14 163 170 vadv(1) = 14 … … 172 179 vadv(4) = 10 173 180 tnom_0(4) = 'PB' 181 else 182 ! Error message, we need a traceur.def file 183 write(lunout,*) trim(modname),& 184 ': Cannot set default tracer names!' 185 write(lunout,*) trim(modname),' Make a traceur.def file!!!' 186 CALL abort_gcm('infotrac_init','Need a traceur.def file!',1) 187 endif ! of if (nqtrue==4) 174 188 END IF 175 189 176 WRITE(lunout,*) 'Valeur de traceur.def :'177 WRITE(lunout,*) 'nombre de traceurs ',nqtrue190 WRITE(lunout,*) trim(modname),': Valeur de traceur.def :' 191 WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue 178 192 DO iq=1,nqtrue 179 193 WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq) … … 217 231 new_iq=new_iq+10 ! 9 tracers added 218 232 ELSE 219 WRITE(lunout,*) 'This choice of advection schema is not available'233 WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq) 220 234 CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1) 221 235 END IF … … 227 241 nqtot = new_iq 228 242 229 WRITE(lunout,*) 'The choice of advection schema for one or more tracers'243 WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers' 230 244 WRITE(lunout,*) 'makes it necessary to add tracers' 231 WRITE(lunout,*) nqtrue,' is the number of true tracers'232 WRITE(lunout,*) nqtot, ' is the total number of tracers needed'245 WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers' 246 WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed' 233 247 234 248 ELSE … … 258 272 iadv(new_iq)=11 259 273 ELSE 260 WRITE(lunout,*)'This choice of advection schema is not available' 274 WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq) 275 261 276 CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1) 262 277 END IF … … 265 280 tname(new_iq)= tnom_0(iq) 266 281 IF (iadv(new_iq)==0) THEN 267 ttext(new_iq)= str1(1:lnblnk(str1))282 ttext(new_iq)=trim(str1) 268 283 ELSE 269 ttext(new_iq)= str1(1:lnblnk(str1))//descrq(iadv(new_iq))284 ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq)) 270 285 END IF 271 286 … … 276 291 new_iq=new_iq+1 277 292 iadv(new_iq)=-20 278 ttext(new_iq)= str2(1:lnblnk(str2))//txts(jq)279 tname(new_iq)= str1(1:lnblnk(str1))//txts(jq)293 ttext(new_iq)=trim(str2)//txts(jq) 294 tname(new_iq)=trim(str1)//txts(jq) 280 295 END DO 281 296 ELSE IF (iadv(new_iq)==30) THEN … … 283 298 new_iq=new_iq+1 284 299 iadv(new_iq)=-30 285 ttext(new_iq)= str2(1:lnblnk(str2))//txtp(jq)286 tname(new_iq)= str1(1:lnblnk(str1))//txtp(jq)300 ttext(new_iq)=trim(str2)//txtp(jq) 301 tname(new_iq)=trim(str1)//txtp(jq) 287 302 END DO 288 303 END IF … … 303 318 304 319 305 WRITE(lunout,*) 'Information stored in infotrac :'306 WRITE(lunout,*) 'iadv niadv tname ttext :'320 WRITE(lunout,*) trim(modname),': Information stored in infotrac :' 321 WRITE(lunout,*) trim(modname),': iadv niadv tname ttext :' 307 322 DO iq=1,nqtot 308 WRITE(lunout,*) iadv(iq),niadv(iq), tname(iq), ttext(iq) 323 WRITE(lunout,*) iadv(iq),niadv(iq),& 324 ' ',trim(tname(iq)),' ',trim(ttext(iq)) 309 325 END DO 310 326 … … 315 331 DO iq=1,nqtot 316 332 IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN 317 WRITE(lunout,*) 'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'333 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ' 318 334 CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1) 319 335 ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN 320 WRITE(lunout,*) 'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'336 WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ' 321 337 CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1) 322 338 END IF -
trunk/libf/dyn3dpar/iniacademic.F
r1 r7 1 1 ! 2 ! $Id: iniacademic.F 14 37 2010-09-30 08:29:10Z emillour $2 ! $Id: iniacademic.F 1446 2010-10-22 09:27:25Z emillour $ 3 3 ! 4 4 c … … 8 8 USE filtreg_mod 9 9 USE infotrac, ONLY : nqtot 10 USE control_mod 10 USE control_mod, ONLY: day_step,planet_type 11 11 #ifdef CPP_IOIPSL 12 12 USE IOIPSL … … 95 95 ! 1. Initializations for Earth-like case 96 96 ! -------------------------------------- 97 if (planet_type=="earth") then98 97 c 99 98 ! initialize planet radius, rotation rate,... … … 128 127 if (.not.read_start) then 129 128 phis(:)=0. 130 q(:,:,1)=1.e-10 131 q(:,:,2)=1.e-15 132 q(:,:,3:nqtot)=0. 129 q(:,:,:)=0 133 130 CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps) 134 131 endif … … 138 135 ! initializations for the academic case 139 136 137 ! if (planet_type=="earth") then 138 140 139 ! 1. local parameters 141 140 ! by convention, winter is in the southern hemisphere … … 219 218 enddo 220 219 220 221 ! else 222 ! write(lunout,*)"iniacademic: planet types other than earth", 223 ! & " not implemented (yet)." 224 ! stop 225 ! endif ! of if (planet_type=="earth") 226 221 227 ! 3. Initialize fields (if necessary) 222 228 IF (.NOT. read_start) THEN … … 245 251 246 252 ! bulk initialization of tracers 247 do i=1,nqtot 248 if (i.eq.1) q(:,:,i)=1.e-10 249 if (i.eq.2) q(:,:,i)=1.e-15 250 if (i.gt.2) q(:,:,i)=0. 251 enddo 253 if (planet_type=="earth") then 254 ! Earth: first two tracers will be water 255 do i=1,nqtot 256 if (i.eq.1) q(:,:,i)=1.e-10 257 if (i.eq.2) q(:,:,i)=1.e-15 258 if (i.gt.2) q(:,:,i)=0. 259 enddo 260 else 261 q(:,:,:)=0 262 endif ! of if (planet_type=="earth") 252 263 253 264 ! add random perturbation to temperature … … 261 272 enddo 262 273 274 ! maintain periodicity in longitude 263 275 do l=1,llm 264 276 do ij=1,ip1jmp1,iip1 … … 267 279 enddo 268 280 269 c PRINT *,' Appel test_period avec tetarappel '270 c CALL test_period ( ucov,vcov,tetarappel,q,p,phis )271 c PRINT *,' Appel test_period avec teta '272 c CALL test_period ( ucov,vcov,teta,q,p,phis )273 274 ! initialize a traceur on one column275 ! j=jjp1*3/4276 ! i=iip1/2277 ! ij=(j-1)*iip1+i278 ! q(ij,:,3)=1.279 280 281 ENDIF ! of IF (.NOT. read_start) 281 282 endif ! of if (iflag_phys.eq.2) 282 283 283 else284 write(lunout,*)"iniacademic: planet types other than earth",285 & " not implemented (yet)."286 stop287 endif ! of if (planet_type=="earth")288 return289 284 END 290 285 c----------------------------------------------------------------------- -
trunk/libf/dyn3dpar/initfluxsto_p.F
r1 r7 1 1 ! 2 ! $Id: initfluxsto_p.F 1 279 2009-12-10 09:02:56Z fairhead$2 ! $Id: initfluxsto_p.F 1438 2010-10-08 10:19:34Z jghattas $ 3 3 ! 4 4 subroutine initfluxsto_p … … 203 203 . llm, nivsigs, zvertiid) 204 204 c pour le fichier def 205 nivd(1) = 1 206 call histvert(filedid, 'sig_s', 'Niveaux sigma', 207 . 'sigma_level', 208 . 1, nivd, dvertiid) 209 205 if (mpi_rank==0) then 206 nivd(1) = 1 207 call histvert(filedid, 'sig_s', 'Niveaux sigma', 208 . 'sigma_level', 209 . 1, nivd, dvertiid) 210 endif 210 211 C 211 212 C Appels a histdef pour la definition des variables a sauvegarder … … 282 283 call histend(fileid) 283 284 call histend(filevid) 284 call histend(filedid)285 if (mpi_rank==0) call histend(filedid) 285 286 if (ok_sync) then 286 287 call histsync(fileid) 287 288 call histsync(filevid) 288 call histsync(filedid)289 if (mpi_rank==0) call histsync(filedid) 289 290 endif 290 291 -
trunk/libf/dyn3dpar/integrd_p.F
r1 r7 1 1 ! 2 ! $Id: integrd_p.F 14 03 2010-07-01 09:02:53Z fairhead$2 ! $Id: integrd_p.F 1446 2010-10-22 09:27:25Z emillour $ 3 3 ! 4 4 SUBROUTINE integrd_p … … 6 6 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold) 7 7 USE parallel 8 USE control_mod 8 USE control_mod, only : planet_type 9 9 IMPLICIT NONE 10 10 … … 279 279 280 280 CALL qminimum_p( q, nq, deltap ) 281 endif ! of if (planet_type.eq."earth")282 281 c 283 282 c ..... Calcul de la valeur moyenne, unique aux poles pour q ..... … … 337 336 ENDDO 338 337 c$OMP END DO NOWAIT 338 339 endif ! of if (planet_type.eq."earth") 340 339 341 c 340 342 c -
trunk/libf/dyn3dpar/leapfrog_p.F
r1 r7 1 1 ! 2 ! $Id: leapfrog_p.F 14 37 2010-09-30 08:29:10Z emillour $2 ! $Id: leapfrog_p.F 1446 2010-10-22 09:27:25Z emillour $ 3 3 ! 4 4 c … … 234 234 235 235 c$OMP MASTER 236 dq =0.236 dq(:,:,:)=0. 237 237 CALL pression ( ip1jmp1, ap, bp, ps, p ) 238 238 CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) … … 596 596 . flxw,pk, iapptrac) 597 597 598 IF (offline) THEN 599 Cmaf stokage du flux de masse pour traceurs OFF-LINE 600 601 #ifdef CPP_IOIPSL 602 CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis, 603 . dtvr, itau) 604 #endif 605 606 607 ENDIF ! of IF (offline) 608 c 598 C Stokage du flux de masse pour traceurs OFF-LINE 599 IF (offline .AND. .NOT. adjust) THEN 600 CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis, 601 . dtvr, itau) 602 ENDIF 603 609 604 ENDIF ! of IF( forward. OR . leapf ) 610 605 cc$OMP END PARALLEL … … 1493 1488 c$OMP MASTER 1494 1489 1495 if (planet_type.eq."earth") then1490 ! if (planet_type.eq."earth") then 1496 1491 ! Write an Earth-format restart file 1497 1492 CALL dynredem1_p("restart.nc",0.0, 1498 1493 & vcov,ucov,teta,q,masse,ps) 1499 endif ! of if (planet_type.eq."earth")1494 ! endif ! of if (planet_type.eq."earth") 1500 1495 1501 1496 ! CLOSE(99) … … 1686 1681 1687 1682 IF(itau.EQ.itaufin) THEN 1688 if (planet_type.eq."earth") then1683 ! if (planet_type.eq."earth") then 1689 1684 c$OMP MASTER 1690 1685 CALL dynredem1_p("restart.nc",0.0, 1691 1686 . vcov,ucov,teta,q,masse,ps) 1692 1687 c$OMP END MASTER 1693 endif ! of if (planet_type.eq."earth")1688 ! endif ! of if (planet_type.eq."earth") 1694 1689 ENDIF ! of IF(itau.EQ.itaufin) 1695 1690 -
trunk/libf/dyn3dpar/limit_netcdf.F90
r1 r7 1 1 ! 2 ! $Id: limit_netcdf.F90 14 25 2010-09-02 13:45:23Z lguez$2 ! $Id: limit_netcdf.F90 1441 2010-10-13 13:06:56Z emillour $ 3 3 !------------------------------------------------------------------------------- 4 4 ! … … 97 97 kappa = 0.2857143 98 98 cpp = 1004.70885 99 dtvr = daysec/ FLOAT(day_step)99 dtvr = daysec/REAL(day_step) 100 100 CALL inigeom 101 101 … … 265 265 266 266 DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug) 267 #endif268 ! of #ifdef CPP_EARTH269 267 270 268 … … 592 590 593 591 !--- Mid-months times 594 mid_months(1)=0.5* FLOAT(mnth(1))592 mid_months(1)=0.5*REAL(mnth(1)) 595 593 DO k=2,nm 596 mid_months(k)=mid_months(k-1)+0.5* FLOAT(mnth(k-1)+mnth(k))594 mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k)) 597 595 END DO 598 596 … … 626 624 !------------------------------------------------------------------------------- 627 625 626 #endif 627 ! of #ifdef CPP_EARTH 628 628 629 629 END SUBROUTINE limit_netcdf
Note: See TracChangeset
for help on using the changeset viewer.