- Timestamp:
- Sep 20, 2024, 12:32:04 PM (9 hours ago)
- Location:
- LMDZ6/branches/cirrus
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/cirrus
- Property svn:mergeinfo changed
-
LMDZ6/branches/cirrus/libf/phylmdiso/isotopes_routines_mod.F90
r4491 r5202 1525 1525 #endif 1526 1526 pxtfra=max(min(pxtfra,alpha_max),0.0) 1527 1528 1527 1529 1528 end subroutine fractcalk_liq … … 15922 15921 15923 15922 ! verif 15924 ! text="phyisoetat0 67"15925 ! write(*,*) 'snow(8,1)=',snow(8,1)15926 ! write(*,*) 'xtsnow(4,8,1)=',xtsnow(4,8,1)15927 15923 #ifdef ISOVERIF 15928 15924 do i=1,klon … … 15934 15930 enddo !do ixt=1,niso 15935 15931 enddo !do i=1,klon 15936 #endif15937 #ifdef ISOVERIF15938 15932 do i=1,klon 15939 15933 if (iso_eau.gt.0) then … … 16021 16015 endif 16022 16016 enddo !do i=1,klon 16023 16024 16017 #endif 16025 16018 !end verif … … 16128 16121 deltaD_run_off_lic_0(ixt)=deltaD_sol(ixt) 16129 16122 deltaD_land_ice(ixt)=deltaD_snow(ixt) 16130 call fractcalk_liq(ixt, 283.0, alpha(ixt)) 16123 call fractcalk_liq(ixt, 283.0, alpha(ixt)) 16131 16124 enddo !do ixt=1,niso 16132 16125 call calcul_kcin(2.0,kcin) … … 18830 18823 if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then 18831 18824 if (q.gt.ridicule) then 18825 write(*,*) 'xt,q=',xt,q 18826 write(*,*) 'alpha=',alpha 18827 write(*,*) 'toce,kcin,h0=',toce,kcin,h0 18828 write(*,*) 'RMerlivat=',RMerlivat 18832 18829 call iso_verif_aberrant_encadre( xt/q, 'isotopes_routines_mod 18930b: iso_init_ideal') 18833 18830 endif … … 18902 18899 end subroutine appel_stewart_debug 18903 18900 18901 18902 subroutine dispatch(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri) 18903 18904 use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso 18905 implicit none 18906 18907 ! inputs 18908 integer, intent(in) :: klon,klev 18909 real,dimension(klon,klev,nqtot), intent(in) ::qx 18910 18911 ! outputs 18912 real,dimension(klon,klev), intent(out) ::q_seri,ql_seri,qs_seri 18913 real,dimension(ntraciso,klon,klev), intent(out) :: xt_seri,xtl_seri,xts_seri 18914 18915 ! locals 18916 integer :: i,k,ixt 18917 18918 do k=1,klev 18919 do i=1,klon 18920 q_seri(i,k) = qx(i,k,ivap) 18921 ql_seri(i,k) = qx(i,k,iliq) 18922 IF (nqo.EQ.2) THEN !--vapour and liquid only 18923 qs_seri(i,k) = 0. 18924 ELSE IF (nqo.ge.3) THEN !--vapour, liquid and ice 18925 qs_seri(i,k) = qx(i,k,isol) 18926 ENDIF 18927 do ixt=1,ntraciso 18928 xt_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,ivap)) 18929 xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq)) 18930 if (nqo.eq.2) then 18931 xts_seri(ixt,i,k) = 0. 18932 else if (nqo.eq.3) then 18933 xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol)) 18934 endif 18935 enddo !do ixt=1,niso 18936 18937 enddo 18938 enddo 18939 18940 end subroutine dispatch 18941 18942 subroutine together(klon,klev,qx,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri) 18943 18944 use infotrac_phy, ONLY: nqtot,nqo,ivap,iliq,isol,iqIsoPha,ntraciso=>ntiso 18945 implicit none 18946 18947 ! inputs 18948 integer, intent(in) :: klon,klev 18949 real,dimension(klon,klev), intent(in) ::q_seri,ql_seri,qs_seri 18950 real,dimension(ntraciso,klon,klev), intent(in) :: xt_seri,xtl_seri,xts_seri 18951 18952 ! inputs 18953 real,dimension(klon,klev,nqtot), intent(out) ::qx 18954 18955 ! locals 18956 integer :: i,k,ixt 18957 18958 do k=1,klev 18959 do i=1,klon 18960 qx(i,k,ivap) = q_seri(i,k) 18961 qx(i,k,iliq) = ql_seri(i,k) 18962 IF (nqo.ge.3) THEN !--vapour, liquid and ice 18963 qx(i,k,isol) = qs_seri(i,k) 18964 ENDIF 18965 do ixt=1,ntraciso 18966 qx(i,k,iqIsoPha(ixt,ivap)) = xt_seri(ixt,i,k) 18967 qx(i,k,iqIsoPha(ixt,iliq)) = xtl_seri(ixt,i,k) 18968 if (nqo.ge.3) then 18969 qx(i,k,iqIsoPha(ixt,isol)) = xts_seri(ixt,i,k) 18970 endif 18971 enddo !do ixt=1,niso 18972 18973 enddo 18974 enddo 18975 18976 end subroutine together 18977 18978 18904 18979 END MODULE isotopes_routines_mod 18905 18980 #endif
Note: See TracChangeset
for help on using the changeset viewer.