Changeset 4123 for LMDZ6/trunk/libf/phylmdiso
- Timestamp:
- Apr 8, 2022, 2:21:26 PM (3 years ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/phylmdiso/cv3_routines.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmdiso/cv3_routines.F90
r4050 r4123 4743 4743 use infotrac_phy, ONLY: ntraciso,niso, & 4744 4744 & ntraceurs_zone,index_trac 4745 use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO 4745 use isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18 4746 4746 #ifdef ISOVERIF 4747 4747 use isotopes_verif_mod, ONLY: errmax,errmaxrel, & 4748 iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, &4748 iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant,iso_verif_O18_aberrant, & 4749 4749 iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, & 4750 4750 iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, & 4751 iso_verif_positif 4751 iso_verif_positif,iso_verif_O18_aberrant_nostop,deltaO 4752 4752 #endif 4753 4753 #ifdef ISOTRAC … … 5293 5293 call iso_verif_aberrant((xt(iso_HDO,il,1) & 5294 5294 & +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), & 5295 & 'cv3_yield 3125, ddft en 1') 5295 & 'cv3_yield 3125, ddft en 1') 5296 endif !if (iso_HDO.gt.0) then 5297 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. & 5298 & (rr(il,1)+delt*fr(il,1).gt.ridicule)) then 5299 call iso_verif_O18_aberrant((xt(iso_HDO,il,1) & 5300 & +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)),(xt(iso_O18,il,1) & 5301 & +delt*fxt(iso_O18,il,1))/(rr(il,1)+delt*fr(il,1)), & 5302 & 'cv3_yield 3125b, ddft en 1') 5296 5303 endif !if (iso_HDO.gt.0) then 5297 5304 #ifdef ISOTRAC … … 5386 5393 & +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), & 5387 5394 & 'cv3_yield 3127, dtr melanges') 5395 endif !if (iso_HDO.gt.0) then 5396 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. & 5397 & (rr(il,1)+delt*fr(il,1).gt.ridicule)) then 5398 call iso_verif_O18_aberrant((xt(iso_HDO,il,1) & 5399 & +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)),(xt(iso_O18,il,1) & 5400 & +delt*fxt(iso_O18,il,1))/(rr(il,1)+delt*fr(il,1)), & 5401 & 'cv3_yield 3127b, dtr melanges') 5388 5402 endif !if (iso_HDO.gt.0) then 5389 5403 #ifdef ISOTRAC … … 6111 6125 & /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3384, flux masse') 6112 6126 endif !if (iso_HDO.gt.0) then 6127 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. & 6128 & (rr(il,i)+delt*fr(il,i).gt.ridicule)) then 6129 call iso_verif_O18_aberrant((xt(iso_HDO,il,i) & 6130 & +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) & 6131 & +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), & 6132 & 'cv3_yield 3384b, flux masse') 6133 endif !if (iso_HDO.gt.0) then 6113 6134 #ifdef ISOTRAC 6114 6135 call iso_verif_traceur_justmass(fxt(1,il,1),'cv3_routine 3626') … … 6344 6365 do ixt = 1, ntraciso 6345 6366 fxt(ixt,il,i)=fxt(ixt,il,i) & 6346 & +0. 1*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))6367 & +0.01*grav*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i)) 6347 6368 enddo 6348 6369 6349 6370 #ifdef DIAGISO 6350 6371 fq_detrainement(il,i)=fq_detrainement(il,i) & 6351 +0. 1*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))6372 +0.01*grav*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i)) 6352 6373 f_detrainement(il,i)=f_detrainement(il,i) & 6353 +0. 1*dpinv*ment(il,k,i)6374 +0.01*grav*dpinv*ment(il,k,i) 6354 6375 q_detrainement(il,i)=q_detrainement(il,i) & 6355 +0. 1*dpinv*ment(il,k,i)*qent(il,k,i)6376 +0.01*grav*dpinv*ment(il,k,i)*qent(il,k,i) 6356 6377 do ixt = 1, niso 6357 6378 fxt_detrainement(ixt,il,i)=fxt_detrainement(ixt,il,i) & 6358 & +0. 1*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i))6379 & +0.01*grav*dpinv*ment(il,k,i)*(xtent(ixt,il,k,i)-xt(ixt,il,i)) 6359 6380 xt_detrainement(ixt,il,i)=xt_detrainement(ixt,il,i) & 6360 & +0. 1*dpinv*ment(il,k,i)*xtent(ixt,il,k,i)6381 & +0.01*grav*dpinv*ment(il,k,i)*xtent(ixt,il,k,i) 6361 6382 enddo 6362 6383 #endif … … 6387 6408 & /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3605b, dtr mels') 6388 6409 endif !if (iso_HDO.gt.0) then 6410 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. & 6411 & (rr(il,i)+delt*fr(il,i).gt.ridicule)) then 6412 call iso_verif_O18_aberrant((xt(iso_HDO,il,i) & 6413 & +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) & 6414 & +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), & 6415 & 'cv3_yield 6415c, dtr mels') 6416 endif !if (iso_HDO.gt.0) then 6389 6417 #ifdef ISOTRAC 6390 6418 call iso_verif_traceur_justmass(fxt(1,il,i),'cv3_routine 3972') … … 6553 6581 6554 6582 #ifdef ISOVERIF 6583 do i=inb(il)-1,inb(il) 6555 6584 if (iso_eau.gt.0) then 6556 call iso_verif_egalite(fxt(iso_eau,il,i nb(il)-1), &6557 & fr(il,i nb(il)-1),'cv3_routines 5308')6585 call iso_verif_egalite(fxt(iso_eau,il,i), & 6586 & fr(il,i),'cv3_routines 5308') 6558 6587 endif !if (iso_eau.gt.0) then 6559 6588 if ((iso_HDO.gt.0).and. & 6560 & (rr(il,inb(il)-1)+delt*fr(il,inb(il)-1).gt.ridicule)) then 6561 call iso_verif_aberrant((xt(iso_HDO,il,inb(il)-1) & 6562 & +delt*fxt(iso_HDO,il,inb(il)-1)) & 6563 & /(rr(il,inb(il)-1)+delt*fr(il,inb(il)-1)),'cv3_yield 6555') 6564 endif !if (iso_HDO.gt.0) then 6589 & (rr(il,i)+delt*fr(il,i).gt.ridicule)) then 6590 call iso_verif_aberrant((xt(iso_HDO,il,i) & 6591 & +delt*fxt(iso_HDO,il,i)) & 6592 & /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6555') 6593 endif !if (iso_HDO.gt.0) then 6594 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. & 6595 & (rr(il,i)+delt*fr(il,i).gt.ridicule)) then 6596 if (iso_verif_O18_aberrant_nostop((xt(iso_HDO,il,i) & 6597 & +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) & 6598 & +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), & 6599 & 'cv3_yield 6555b').eq.1) then 6600 write(*,*) 'il,i=',il,i 6601 write(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i)) 6602 write(*,*) 'deltaOapres=',deltaO((xt(iso_O18,il,i) & 6603 & +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i))) 6604 write(*,*) 'rr,fq*delt=',rr(il,i),delt*fr(il,i) 6605 write(*,*) 'deltaOfq=',deltaO(fxt(iso_O18,il,i)/fr(il,i)) 6606 write(*,*) 'xt,fxt*delt=',xt(iso_O18,il,i),delt*fxt(iso_O18,il,i) 6607 write(*,*) 'qent(il,inb(il),inb(il)),rr(il,inb(il))=', & 6608 & qent(il,inb(il),inb(il)),rr(il,inb(il)) 6609 write(*,*) 'xtent(il,inb(il),inb(il)),xt(il,inb(il))=', & 6610 & xtent(iso_O18,il,inb(il),inb(il)),xt(iso_O18,il,inb(il)) 6611 write(*,*) 'deltaOent=',deltaO(xtent(iso_O18,il,inb(il),inb(il))/qent(il,inb(il),inb(il))) 6612 write(*,*) 'bx,xtbx(iso_O18)=',bx,xtbx(iso_O18) 6613 stop 6614 6615 endif 6616 endif !if (iso_HDO.gt.0) then 6617 enddo 6565 6618 #endif 6566 6619 #endif … … 6752 6805 & +delt*fxt(iso_HDO,il,i)) & 6753 6806 & /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6744') 6754 endif !if (iso_HDO.gt.0) then 6807 endif !if (iso_HDO.gt.0) then 6808 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. & 6809 & (rr(il,i)+delt*fr(il,i).gt.ridicule)) then 6810 call iso_verif_O18_aberrant((xt(iso_HDO,il,i) & 6811 & +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) & 6812 & +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), & 6813 & 'cv3_yield 6744b') 6814 endif !if (iso_HDO.gt.0) then 6755 6815 #endif 6756 6816 #endif … … 6800 6860 print *,' CV3_YIELD : alpha_qpos ',alpha_qpos(1) 6801 6861 ENDIF 6862 6802 6863 ! 6803 6864 DO il = 1, ncum … … 6841 6902 call iso_verif_aberrant((xt(iso_HDO,il,i) & 6842 6903 & +delt*fxt(iso_HDO,il,i)) & 6843 & /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6835') 6844 endif !if (iso_HDO.gt.0) then 6904 & /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6835a') 6905 endif !if (iso_HDO.gt.0) then 6906 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. & 6907 & (rr(il,i)+delt*fr(il,i).gt.ridicule)) then 6908 if (iso_verif_O18_aberrant_nostop((xt(iso_HDO,il,i) & 6909 & +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)),(xt(iso_O18,il,i) & 6910 & +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), & 6911 & 'cv3_yield 6835b').eq.1) then 6912 write(*,*) 'il,i=',il,i 6913 write(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i)) 6914 write(*,*) 'deltaOapres=',deltaO((xt(iso_O18,il,i) & 6915 & +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i))) 6916 write(*,*) 'rr,fq*delt=',rr(il,i),delt*fr(il,i) 6917 write(*,*) 'alpha_qpos=',alpha_qpos(il) 6918 write(*,*) 'fq*delt avantqpos=',delt*fr(il,i)*alpha_qpos(il) 6919 write(*,*) 'deltaO avantqpos=',deltaO((xt(iso_O18,il,i) & 6920 & +delt*fxt(iso_O18,il,i)*alpha_qpos(il))/(rr(il,i)+delt*fr(il,i)*alpha_qpos(il))) 6921 write(*,*) 'deltaOfq=',deltaO(fxt(iso_O18,il,i)/fr(il,i)) 6922 write(*,*) 'xt,fxt*delt=',xt(iso_O18,il,i),delt*fxt(iso_O18,il,i) 6923 stop 6924 endif 6925 endif !if (iso_HDO.gt.0) then 6845 6926 #endif 6846 6927 #ifdef DIAGISO
Note: See TracChangeset
for help on using the changeset viewer.
