Changeset 5158 for LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90
- Timestamp:
- Aug 2, 2024, 2:12:03 PM (3 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90
r5153 r5158 2604 2604 WRITE(*,*) 'physiq 1846b: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso 2605 2605 #endif 2606 doixt=1,ntraciso2606 DO ixt=1,ntraciso 2607 2607 #ifdef ISOVERIF 2608 2608 WRITE(*,*) 'physiq tmp 1762a: ixt,iqiso_vap=',ixt,iqIsoPha(ixt,ivap) … … 2684 2684 WRITE(lunout,*)' WARNING: tr_ancien initialised to tr_seri' 2685 2685 itr = 0 2686 doiq = 1, nqtot2686 DO iq = 1, nqtot 2687 2687 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 2688 2688 itr = itr+1 … … 2705 2705 #ifdef ISOVERIF 2706 2706 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN 2707 do i=1,klon2708 do k=1,klev2707 DO i=1,klon 2708 DO k=1,klev 2709 2709 IF (q_seri(i,k).gt.ridicule) THEN 2710 2710 IF (iso_verif_o18_aberrant_nostop( & … … 2776 2776 DO k = 1, klev 2777 2777 DO i = 1, klon 2778 doixt=1,ntraciso2778 DO ixt=1,ntraciso 2779 2779 d_xt_dyn(ixt,i,k) = & 2780 2780 (xt_seri(ixt,i,k)-xt_ancien(ixt,i,k))/phys_tstep … … 2791 2791 DO k = 1, klev 2792 2792 DO i = 1, klon 2793 doixt=1,ntraciso2793 DO ixt=1,ntraciso 2794 2794 CALL iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2220') 2795 2795 CALL iso_verif_noNaN(xtl_seri(ixt,i,k),'physiq 2220b') … … 2865 2865 DO k = 1, klev 2866 2866 DO i = 1, klon 2867 doixt=1,ntraciso2867 DO ixt=1,ntraciso 2868 2868 d_xt_dyn(ixt,i,k)= 0.0 2869 2869 d_xtl_dyn(ixt,i,k)= 0.0 … … 3017 3017 DO k = 1, klev 3018 3018 DO i = 1, klon 3019 doixt=1,ntraciso3019 DO ixt=1,ntraciso 3020 3020 CALL iso_verif_noNaN(xt_seri(ixt,i,k), & 3021 3021 'reevap 2417: apres evap tot') … … 3188 3188 ! Conservation des variables avant l'appel à l a diffusion pour les tehrmic ! 3189 3189 IF (iflag_thermals_tenv / 10 == 1 ) then ! 3190 dok=1,klev !3191 doi=1,klon !3190 DO k=1,klev ! 3191 DO i=1,klon ! 3192 3192 t_env(i,k)=t_seri(i,k) ! 3193 3193 q_env(i,k)=q_seri(i,k) 3194 3194 #ifdef ISO 3195 doixt=1,ntraciso3195 DO ixt=1,ntraciso 3196 3196 xt_env(ixt,i,k)=xt_seri(ixt,i,k) 3197 3197 enddo … … 3200 3200 enddo ! 3201 3201 ELSE IF (iflag_thermals_tenv / 10 == 2 ) then ! 3202 dok=1,klev !3203 doi=1,klon !3202 DO k=1,klev ! 3203 DO i=1,klon ! 3204 3204 t_env(i,k)=t_seri(i,k) ! 3205 3205 enddo ! … … 3319 3319 ! WRITE(*,*) 'physiq 2402: apres pbl_surface' 3320 3320 #ifdef ISOVERIF 3321 doi=1,klon3322 dok=1,klev3323 doixt=1,ntraciso3321 DO i=1,klon 3322 DO k=1,klev 3323 DO ixt=1,ntraciso 3324 3324 CALL iso_verif_noNaN(d_xt_vdf(ixt,i,k),'physiq 1993a') 3325 3325 CALL iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 1993b') … … 3329 3329 #endif 3330 3330 #ifdef ISOVERIF 3331 doi=1,klon3332 do k=1,klev3331 DO i=1,klon 3332 DO k=1,klev 3333 3333 #ifdef ISOTRAC 3334 3334 CALL iso_verif_traceur_justmass(d_xt_vdf(1,i,k),'physiq 2443') … … 3345 3345 ! WRITE(*,*) 'physiq 2665: d_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19) 3346 3346 ! WRITE(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1) 3347 doi=1,klon3347 DO i=1,klon 3348 3348 ! WRITE(*,*) 'physiq 2667: i,k=',i,k 3349 3349 ! WRITE(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19) 3350 3350 ! WRITE(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1) 3351 dok=1,klev3351 DO k=1,klev 3352 3352 ! WRITE(*,*) 'physiq 2670: i,k=',i,k 3353 3353 ! WRITE(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19) … … 3360 3360 xt_seri(iso_eau,i,k),q_seri(i,k), & 3361 3361 'physiq 1985',errmax,errmaxrel) 3362 donsrf=1,nbsrf3362 DO nsrf=1,nbsrf 3363 3363 CALL iso_verif_egalite_choix(fluxxt(iso_eau,i,k,nsrf), & 3364 3364 fluxq(i,k,nsrf),'physiq 1991',errmax,errmaxrel) … … 3368 3368 endif !if (iso_eau.gt.0) THEN 3369 3369 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN 3370 do i=1,klon3371 do k=1,klev3370 DO i=1,klon 3371 DO k=1,klev 3372 3372 IF (q_seri(i,k).gt.ridicule) THEN 3373 3373 IF (iso_verif_o18_aberrant_nostop( & … … 3640 3640 3641 3641 #ifdef ISOVERIF 3642 dok = 1, klev3643 doi = 1, klon3642 DO k = 1, klev 3643 DO i = 1, klon 3644 3644 CALL iso_verif_positif(q_seri(i,k),'physic 2929') 3645 3645 enddo … … 3652 3652 wake_deltaxt, & 3653 3653 'physiq 2704c, wake_deltaxt',ntraciso,klon,klev) 3654 dok = 1, klev3655 doi = 1, klon3656 doixt=1,ntraciso3654 DO k = 1, klev 3655 DO i = 1, klon 3656 DO ixt=1,ntraciso 3657 3657 CALL iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2757') 3658 3658 enddo ! do ixt=1,ntraciso … … 3673 3673 endif 3674 3674 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN 3675 dok = 1, klev3676 doi = 1, klon3675 DO k = 1, klev 3676 DO i = 1, klon 3677 3677 IF (q_seri(i,k).gt.ridicule) THEN 3678 3678 IF (iso_verif_o18_aberrant_nostop( & … … 3703 3703 q_x(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k) 3704 3704 #ifdef ISO 3705 doixt=1,ntraciso3705 DO ixt=1,ntraciso 3706 3706 xt_w(ixt,i,k) = xt_seri(ixt,i,k) + (1-wake_s(i))*wake_deltaxt(ixt,i,k) 3707 3707 xt_x(ixt,i,k) = xt_seri(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k) … … 3738 3738 q_x(:,:) = q_seri(:,:) 3739 3739 #ifdef ISO 3740 doixt=1,ntraciso3740 DO ixt=1,ntraciso 3741 3741 xt_w(ixt,:,:) = xt_seri(ixt,:,:) 3742 3742 xt_x(ixt,:,:) = xt_seri(ixt,:,:) … … 3777 3777 d_deltaq_ajs_cv(i,k) = d_q_adjwk(i,k) 3778 3778 #ifdef ISO 3779 doixt=1,ntraciso3779 DO ixt=1,ntraciso 3780 3780 xt_w(ixt,i,k) = xt_w(ixt,i,k) + d_xt_adjwk(ixt,i,k) 3781 3781 d_deltaxt_ajs_cv(ixt,i,k) = d_xt_adjwk(ixt,i,k) … … 3786 3786 d_deltaq_ajs_cv(i,k) = 0. 3787 3787 #ifdef ISO 3788 doixt=1,ntraciso3788 DO ixt=1,ntraciso 3789 3789 d_deltaxt_ajs_cv(ixt,i,k) = 0. 3790 3790 enddo … … 3826 3826 #ifdef ISOVERIF 3827 3827 WRITE(*,*) 'physic 2553: avant appel concvl' 3828 dok = 1, klev3829 doi = 1, klon3830 doixt=1,ntraciso3828 DO k = 1, klev 3829 DO i = 1, klon 3830 DO ixt=1,ntraciso 3831 3831 CALL iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2925a') 3832 3832 CALL iso_verif_noNaN(xt_x(ixt,i,k),'physiq 2925b') … … 3897 3897 IF ((bidouille_anti_divergence).AND. & 3898 3898 (iso_eau.gt.0)) THEN 3899 dok=1,klev3900 do i=1,klon3899 DO k=1,klev 3900 DO i=1,klon 3901 3901 xt_seri(iso_eau,i,k)= q_seri(i,k) 3902 3902 xt_x(iso_eau,i,k)= q_x(i,k) … … 4050 4050 d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k) 4051 4051 #ifdef ISO 4052 doixt=1,ntraciso4052 DO ixt=1,ntraciso 4053 4053 fxtd(ixt,i,k) = fxtd(ixt,i,k) + wake_s(i)*d_xt_adjwk(ixt,i,k)/phys_tstep 4054 4054 d_xt_con(ixt,i,k) = d_xt_con(ixt,i,k) + wake_s(i)*d_xt_adjwk(ixt,i,k) … … 4087 4087 4088 4088 IF (.NOT. ok_gust) THEN 4089 doi = 1, klon4089 DO i = 1, klon 4090 4090 wd(i)=0.0 4091 4091 enddo … … 4231 4231 z_apres(i) = 0.0 4232 4232 #ifdef ISO 4233 doixt=1,ntraciso4233 DO ixt=1,ntraciso 4234 4234 zxt_apres(ixt,i) = 0.0 4235 4235 enddo !do ixt=1,ntraciso … … 4245 4245 DO k = 1, klev 4246 4246 DO i = 1, klon 4247 doixt=1,ntraciso4247 DO ixt=1,ntraciso 4248 4248 zxt_apres(ixt,i) = zxt_apres(ixt,i) & 4249 4249 + (xt_seri(ixt,i,k)+xtl_seri(ixt,i,k)) & … … 4259 4259 #ifdef ISO 4260 4260 DO i = 1, klon 4261 doixt=1,ntraciso4261 DO ixt=1,ntraciso 4262 4262 zxt_factor(ixt,i) = (zxt_avant(ixt,i)-(xtrain_con(ixt,i) & 4263 4263 +xtsnow_con(ixt,i))*phys_tstep)/zxt_apres(ixt,i) … … 4271 4271 q_seri(i,k) = q_seri(i,k) * z_factor(i) 4272 4272 #ifdef ISO 4273 doixt=1,ntraciso4273 DO ixt=1,ntraciso 4274 4274 xt_seri(ixt,i,k)=xt_seri(ixt,i,k)*zxt_factor(ixt,i) 4275 4275 enddo ! do ixt=1,ntraciso … … 4326 4326 dq_a(i,k) = d_q_con(i,k)/phys_tstep - fqd(i,k) 4327 4327 #ifdef ISO 4328 doixt=1,ntraciso4328 DO ixt=1,ntraciso 4329 4329 dxt_dwn(ixt,i,k) = fxtd(ixt,i,k) 4330 4330 dxt_a(ixt,i,k) = d_xt_con(ixt,i,k)/phys_tstep - fxtd(ixt,i,k) … … 4342 4342 ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/phys_tstep 4343 4343 #ifdef ISO 4344 doixt=1,ntraciso4344 DO ixt=1,ntraciso 4345 4345 dxt_dwn(:,k,ixt)= dxt_dwn(:,k,ixt)+ & 4346 4346 ok_wk_lsp(:)*(d_xt_eva(:,k,ixt)+d_xt_lsc(:,k,ixt))/phys_tstep … … 4361 4361 ok_wk_lsp(i)*d_q_lsc(i,k)/phys_tstep 4362 4362 #ifdef ISO 4363 doixt=1,ntraciso4363 DO ixt=1,ntraciso 4364 4364 dxt_dwn(:,k,ixt)= dxt_dwn(:,k,ixt)+ & 4365 4365 ok_wk_lsp(:)*d_xt_lsc(:,k,ixt)/phys_tstep … … 4516 4516 #ifdef ISOVERIF 4517 4517 WRITE(*,*) 'physiq 3570' 4518 dok=1,klev4519 doi=1,klon4518 DO k=1,klev 4519 DO i=1,klon 4520 4520 IF (iso_eau.gt.0) THEN 4521 4521 CALL iso_verif_egalite_choix(xt_seri(iso_eau,i,k), & … … 4564 4564 !#ifdef ISOVERIF 4565 4565 IF ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN 4566 do k=1,klev4567 doi=1,klon4566 DO k=1,klev 4567 DO i=1,klon 4568 4568 xt_seri(iso_eau,i,k)=q_seri(i,k) 4569 4569 enddo !do i=1,klon … … 4602 4602 ! A detruire en 2024 une fois les tests documentes et les choix faits ! 4603 4603 IF (iflag_thermals_tenv /10 == 0 ) then ! 4604 dok=1,klev !4605 doi=1,klon !4604 DO k=1,klev ! 4605 DO i=1,klon ! 4606 4606 t_env(i,k)=t_seri(i,k) ! 4607 4607 q_env(i,k)=q_seri(i,k) ! 4608 4608 #ifdef ISO 4609 doixt=1,ntraciso4609 DO ixt=1,ntraciso 4610 4610 xt_env(ixt,i,k)=xt_seri(ixt,i,k) 4611 4611 enddo … … 4614 4614 enddo ! 4615 4615 ELSE IF (iflag_thermals_tenv / 10 == 2 ) then ! 4616 dok=1,klev !4617 doi=1,klon !4616 DO k=1,klev ! 4617 DO i=1,klon ! 4618 4618 q_env(i,k)=q_seri(i,k) ! 4619 4619 #ifdef ISO 4620 doixt=1,ntraciso4620 DO ixt=1,ntraciso 4621 4621 xt_env(ixt,i,k)=xt_seri(ixt,i,k) 4622 4622 enddo … … 4625 4625 enddo ! 4626 4626 ELSE IF (iflag_thermals_tenv / 10 == 3 ) then ! 4627 dok=1,klev !4628 doi=1,klon !4627 DO k=1,klev ! 4628 DO i=1,klon ! 4629 4629 t_env(i,k)=t(i,k) ! 4630 4630 q_env(i,k)=qx(i,k,1) ! 4631 4631 #ifdef ISO 4632 doixt=1,ntraciso4632 DO ixt=1,ntraciso 4633 4633 xt_env(ixt,i,k)=xt_seri(ixt,i,k) 4634 4634 enddo … … 4652 4652 v_therm(i,k) = v_seri(i,k) 4653 4653 #ifdef ISO 4654 doixt=1,ntraciso4654 DO ixt=1,ntraciso 4655 4655 xt_therm(ixt,i,k) = xt_seri(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k) 4656 4656 xt_env(ixt,i,k) = xt_env(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k) … … 4668 4668 v_therm(i,k) = v_seri(i,k) 4669 4669 #ifdef ISO 4670 doixt=1,ntraciso4670 DO ixt=1,ntraciso 4671 4671 xt_therm(ixt,i,k) = xt_seri(ixt,i,k) 4672 4672 enddo !do ixt=1,ntraciso … … 4740 4740 d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i)) 4741 4741 #ifdef ISO 4742 doixt=1,ntraciso4742 DO ixt=1,ntraciso 4743 4743 d_deltaxt_the(ixt,i,k) = - d_xt_ajs(ixt,i,k) 4744 4744 d_xt_ajs(ixt,i,k) = d_xt_ajs(ixt,i,k)*(1.-wake_s(i)) … … 4840 4840 endif 4841 4841 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN 4842 dok = 1, klev4843 do i = 1, klon4842 DO k = 1, klev 4843 DO i = 1, klon 4844 4844 IF (q_seri(i,k).gt.ridicule) THEN 4845 4845 IF (iso_verif_o18_aberrant_nostop( & … … 4953 4953 #endif 4954 4954 #ifdef ISOVERIF 4955 dok=1,klev4956 doi=1,klon4955 DO k=1,klev 4956 DO i=1,klon 4957 4957 IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN 4958 4958 IF ((q_seri(i,k).gt.ridicule).AND.(k.lt.nlevmaxO17)) THEN … … 4995 4995 4996 4996 ! verif température 4997 dok=1,klev4998 doi=1,klon4997 DO k=1,klev 4998 DO i=1,klon 4999 4999 CALL iso_verif_positif(370.0-t_seri(i,k), & 5000 5000 'physiq 3535, avant il pleut') … … 5008 5008 IF ((bidouille_anti_divergence).AND. & 5009 5009 (iso_eau.gt.0)) THEN 5010 dok=1,klev5011 do i=1,klon5010 DO k=1,klev 5011 DO i=1,klon 5012 5012 xt_seri(iso_eau,i,k)= q_seri(i,k) 5013 5013 enddo !do i=1,klon … … 5071 5071 #ifdef ISOVERIF 5072 5072 DO k = 1, klev 5073 doi=1,klon5073 DO i=1,klon 5074 5074 IF (iso_O18.gt.0.AND.iso_HDO.gt.0) THEN 5075 5075 IF (ql_seri(i,k).gt.ridicule) THEN … … 5108 5108 rain_num(i)=rain_num(i)+(ql_seri(i,k)-oliqmax)*zmasse(i,k)/pdtphys 5109 5109 #ifdef ISO 5110 doixt=1,ntraciso5110 DO ixt=1,ntraciso 5111 5111 xtl_seri(ixt,i,k)=xtl_seri(ixt,i,k)/ql_seri(i,k)*oliqmax 5112 5112 enddo … … 5122 5122 rain_num(i)=rain_num(i)+(qs_seri(i,k)-oicemax)*zmasse(i,k)/pdtphys 5123 5123 #ifdef ISO 5124 doixt=1,ntraciso5124 DO ixt=1,ntraciso 5125 5125 xts_seri(ixt,i,k)=xts_seri(ixt,i,k)/qs_seri(i,k)*oliqmax 5126 5126 enddo … … 5229 5229 ENDDO !DO k = 1, klev 5230 5230 IF ((iso_O17.gt.0).AND.(iso_O18.gt.0)) THEN 5231 do i=1,klon5232 dok=1,nlev5231 DO i=1,klon 5232 DO k=1,nlev 5233 5233 IF ((q_seri(i,k).gt.ridicule).AND.(k.lt.nlevmaxO17)) THEN 5234 5234 CALL iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) & … … 5444 5444 #ifdef ISO 5445 5445 DO i = 1, klon 5446 doixt=1,ntraciso5446 DO ixt=1,ntraciso 5447 5447 xtrain_fall(ixt,i)=xtrain_con(ixt,i) + xtrain_lsc(ixt,i) 5448 5448 xtsnow_fall(ixt,i)=xtsnow_con(ixt,i) + xtsnow_lsc(ixt,i) … … 5486 5486 #endif 5487 5487 #ifdef ISOVERIF 5488 do i=1,klon5489 do ixt=1,ntraciso5488 DO i=1,klon 5489 DO ixt=1,ntraciso 5490 5490 CALL iso_verif_noNaN(xtsnow_con(ixt,i), & 5491 5491 'physiq 4942') … … 5500 5500 #ifdef ISO 5501 5501 IF ((iso_eau.gt.0).AND.(bidouille_anti_divergence)) THEN 5502 doi=1,klon5502 DO i=1,klon 5503 5503 xtrain_fall(iso_eau,i)=rain_fall(i) 5504 5504 enddo !do i=1,klon … … 6600 6600 END IF 6601 6601 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0)) THEN 6602 do i=1,klon6603 do k=1,klev6602 DO i=1,klon 6603 DO k=1,klev 6604 6604 IF (q_seri(i,k).gt.ridicule) THEN 6605 6605 IF (iso_verif_o18_aberrant_nostop( & … … 6750 6750 IF (iso_HTO.gt.0) then ! Tritium 6751 6751 ixt=iso_HTO 6752 doi=1,klon6753 dok=1,klev6752 DO i=1,klon 6753 DO k=1,klev 6754 6754 IF (iso_verif_positif_strict_nostop(xt_seri(ixt,i,k), & 6755 6755 'physiq 5620 : xt_seri(HTO) nul ou negatif').EQ.1) THEN … … 7093 7093 ! C Risi: dispatcher les isotopes dans les xt_seri 7094 7094 #ifdef ISO 7095 doixt=1,ntraciso7095 DO ixt=1,ntraciso 7096 7096 DO k = 1, klev 7097 7097 DO i = 1, klon … … 7309 7309 END IF 7310 7310 WRITE(*,*) 'physiq 3731: verif avant phyisoredem' 7311 dok=1,klev7312 doi=1,klon7311 DO k=1,klev 7312 DO i=1,klon 7313 7313 IF (iso_eau.gt.0) THEN 7314 7314 CALL iso_verif_egalite_choix(xt_ancien(iso_eau,i,k), &
Note: See TracChangeset
for help on using the changeset viewer.
