Changeset 2025 for LMDZ5/trunk/libf/dyn3dpar
- Timestamp:
- Apr 25, 2014, 7:58:33 PM (11 years ago)
- File:
-
- 1 edited
-
LMDZ5/trunk/libf/dyn3dpar/guide_p_mod.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/dyn3dpar/guide_p_mod.F90
r2021 r2025 492 492 IF (f_out) THEN 493 493 ! Calcul niveaux pression milieu de couches 494 495 494 CALL pression_p( ip1jmp1, ap, bp, ps, p ) 495 if (pressure_exner) then 496 496 CALL exner_hyb_p(ip1jmp1,ps,p,pks,pk) 497 497 else 498 498 CALL exner_milieu_p(ip1jmp1,ps,p,pks,pk) 499 499 endif 500 500 unskap=1./kappa 501 502 503 504 505 506 507 508 CALL guide_out(" P",jjp1,llm,p(1:ip1jmp1,1:llm),1.)501 DO l = 1, llm 502 DO j=jjb_u,jje_u 503 DO i =1, iip1 504 p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap 505 ENDDO 506 ENDDO 507 ENDDO 508 CALL guide_out("SP",jjp1,llm,p(1:ip1jmp1,1:llm),1.) 509 509 ENDIF 510 510 … … 518 518 if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add) 519 519 CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u) 520 IF (f_out) CALL guide_out("U",jjp1,llm,f_add(:,:),factt) 520 IF (f_out) CALL guide_out("u",jjp1,llm,ucov,factt) 521 IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(:,:)+tau*ugui2(:,:),factt) 522 IF (f_out) CALL guide_out("ucov",jjp1,llm,f_add(:,:)/factt,factt) 521 523 ucov(ijb_u:ije_u,:)=ucov(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:) 522 524 endif … … 530 532 if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add) 531 533 CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T) 532 IF (f_out) CALL guide_out(" T",jjp1,llm,f_add(:,:),factt)534 IF (f_out) CALL guide_out("teta",jjp1,llm,f_add(:,:)/factt,factt) 533 535 teta(ijb_u:ije_u,:)=teta(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:) 534 536 endif … … 542 544 if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1)) 543 545 CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P) 544 IF (f_out) CALL guide_out(" SP",jjp1,1,f_add(1:ip1jmp1,1),factt)546 IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt,factt) 545 547 ps(ijb_u:ije_u)=ps(ijb_u:ije_u)+f_add(ijb_u:ije_u,1) 546 548 CALL pression_p(ip1jmp1,ap,bp,ps,p) … … 556 558 if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add) 557 559 CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q) 558 IF (f_out) CALL guide_out(" Q",jjp1,llm,f_add(:,:),factt)560 IF (f_out) CALL guide_out("q",jjp1,llm,f_add(:,:)/factt,factt) 559 561 q(ijb_u:ije_u,:)=q(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:) 560 562 endif … … 569 571 if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:)) 570 572 CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v) 571 IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:),factt) 573 IF (f_out) CALL guide_out("v",jjm,llm,vcov(1:ip1jm,:),factt) 574 IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(:,:)+tau*vgui2(:,:),factt) 575 IF (f_out) CALL guide_out("vcov",jjm,llm,f_add(1:ip1jm,:)/factt,factt) 572 576 vcov(ijb_v:ije_v,:)=vcov(ijb_v:ije_v,:)+f_add(ijb_v:ije_v,:) 573 577 endif … … 786 790 IF (guide_plevs.EQ.1) THEN 787 791 DO l=1,llm 788 789 792 DO j=jjb_u,jje_u 793 DO i =1, iip1 790 794 pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2. 791 792 795 ENDDO 796 ENDDO 793 797 ENDDO 794 798 ELSE 795 796 799 CALL pression_p( ip1jmp1, ap, bp, psi, p ) 800 if (pressure_exner) then 797 801 CALL exner_hyb_p(ip1jmp1,psi,p,pks,pk) 798 802 else 799 803 CALL exner_milieu_p(ip1jmp1,psi,p,pks,pk) 800 804 endif 801 802 803 804 805 806 807 808 805 unskap=1./kappa 806 DO l = 1, llm 807 DO j=jjb_u,jje_u 808 DO i =1, iip1 809 pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap 810 ENDDO 811 ENDDO 812 ENDDO 809 813 ENDIF 810 814 … … 1026 1030 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1027 1031 IF (guide_plevs.EQ.1) THEN 1028 1029 1030 1031 1032 1033 1032 CALL Register_SwapFieldHallo(psnat1,psnat1,ip1jmp1,1,jj_Nb_caldyn,1,2,Req) 1033 CALL SendRequest(Req) 1034 CALL WaitRequest(Req) 1035 CALL Register_SwapFieldHallo(psnat2,psnat2,ip1jmp1,1,jj_Nb_caldyn,1,2,Req) 1036 CALL SendRequest(Req) 1037 CALL WaitRequest(Req) 1034 1038 DO l=1,nlevnc 1035 1039 DO j=jjb_v,jje_v … … 1043 1047 ENDDO 1044 1048 ELSE IF (guide_plevs.EQ.2) THEN 1045 1046 1047 1048 1049 1050 1049 CALL Register_SwapFieldHallo(pnat1,pnat1,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req) 1050 CALL SendRequest(Req) 1051 CALL WaitRequest(Req) 1052 CALL Register_SwapFieldHallo(pnat2,pnat2,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req) 1053 CALL SendRequest(Req) 1054 CALL WaitRequest(Req) 1051 1055 DO l=1,nlevnc 1052 1056 DO j=jjb_v,jje_v … … 1809 1813 1810 1814 ! Variables entree 1811 CHARACTER , INTENT(IN) :: varname1815 CHARACTER*(*), INTENT(IN) :: varname 1812 1816 INTEGER, INTENT (IN) :: hsize,vsize 1813 1817 REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field … … 1819 1823 INTEGER :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev 1820 1824 INTEGER :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev 1825 INTEGER :: vid_au,vid_av 1826 INTEGER :: l 1821 1827 INTEGER, DIMENSION (3) :: dim3 1822 1828 INTEGER, DIMENSION (4) :: dim4,count,start 1823 1829 INTEGER :: ierr, varid 1830 REAL, DIMENSION (iip1,hsize,vsize) :: field2 1824 1831 1825 1832 CALL gather_field(field,iip1*hsize,vsize,0) … … 1836 1843 ! Definition des dimensions 1837 1844 ierr=NF_DEF_DIM(nid,"LONU",iip1,id_lonu) 1845 print*,'id_lonu 1 ',id_lonu 1838 1846 ierr=NF_DEF_DIM(nid,"LONV",iip1,id_lonv) 1839 1847 ierr=NF_DEF_DIM(nid,"LATU",jjp1,id_latu) … … 1844 1852 ! Creation des variables dimensions 1845 1853 ierr=NF_DEF_VAR(nid,"LONU",NF_FLOAT,1,id_lonu,vid_lonu) 1854 print*,'id_lonu 2 ',id_lonu 1846 1855 ierr=NF_DEF_VAR(nid,"LONV",NF_FLOAT,1,id_lonv,vid_lonv) 1847 1856 ierr=NF_DEF_VAR(nid,"LATU",NF_FLOAT,1,id_latu,vid_latu) … … 1850 1859 ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu) 1851 1860 ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv) 1861 ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au) 1862 ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av) 1852 1863 1853 1864 ierr=NF_ENDDEF(nid) … … 1855 1866 ! Enregistrement des variables dimensions 1856 1867 #ifdef NC_DOUBLE 1868 print*,'id_lonu DOUBLE ',id_lonu,rlonu*180./pi 1857 1869 ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi) 1858 1870 ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi) … … 1862 1874 ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu) 1863 1875 ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv) 1876 ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u) 1877 ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v) 1864 1878 #else 1879 print*,'id_lonu 3 ',id_lonu,rlonu*180./pi 1865 1880 ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi) 1866 1881 ierr = NF_PUT_VAR_REAL(nid,vid_lonv,rlonv*180./pi) … … 1870 1885 ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu) 1871 1886 ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv) 1887 ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u) 1888 ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v) 1872 1889 #endif 1873 1890 ! -------------------------------------------------------------------- … … 1877 1894 ! Pressure (GCM) 1878 1895 dim4=(/id_lonv,id_latu,id_lev,id_tim/) 1879 ierr = NF_DEF_VAR(nid," P",NF_FLOAT,4,dim4,varid)1896 ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid) 1880 1897 ! Surface pressure (guidage) 1881 1898 IF (guide_P) THEN … … 1885 1902 ! Zonal wind 1886 1903 IF (guide_u) THEN 1904 print*,'id_lonu 4 ',id_lonu,varname 1887 1905 dim4=(/id_lonu,id_latu,id_lev,id_tim/) 1906 ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid) 1907 ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid) 1888 1908 ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid) 1889 1909 ENDIF … … 1891 1911 IF (guide_v) THEN 1892 1912 dim4=(/id_lonv,id_latv,id_lev,id_tim/) 1913 ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid) 1914 ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid) 1893 1915 ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid) 1894 1916 ENDIF … … 1914 1936 ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid) 1915 1937 1938 IF (varname=="SP") timestep=timestep+1 1939 1940 IF (varname=="SP") THEN 1941 print*,'varname=SP=',varname 1942 ELSE 1943 print*,'varname diff SP=',varname 1944 ENDIF 1945 1946 1947 ierr = NF_INQ_VARID(nid,varname,varid) 1916 1948 SELECT CASE (varname) 1917 CASE ("P") 1918 timestep=timestep+1 1919 ierr = NF_INQ_VARID(nid,"P",varid) 1949 CASE ("SP","ps") 1920 1950 start=(/1,1,1,timestep/) 1921 1951 count=(/iip1,jjp1,llm,1/) 1922 #ifdef NC_DOUBLE 1923 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field) 1924 #else 1925 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field) 1926 #endif 1927 CASE ("SP") 1928 ierr = NF_INQ_VARID(nid,"ps",varid) 1929 start=(/1,1,timestep,0/) 1930 count=(/iip1,jjp1,1,0/) 1931 #ifdef NC_DOUBLE 1932 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt) 1933 #else 1934 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt) 1935 #endif 1936 CASE ("U") 1937 ierr = NF_INQ_VARID(nid,"ucov",varid) 1952 CASE ("v","va","vcov") 1953 start=(/1,1,1,timestep/) 1954 count=(/iip1,jjm,llm,1/) 1955 CASE DEFAULT 1938 1956 start=(/1,1,1,timestep/) 1939 1957 count=(/iip1,jjp1,llm,1/) 1958 END SELECT 1959 1960 SELECT CASE (varname) 1961 CASE("u","ua") 1962 DO l=1,llm ; field2(:,2:jjm,l)=field(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO 1963 field2(:,1,:)=0. ; field2(:,jjp1,:)=0. 1964 CASE("v","va") 1965 DO l=1,llm ; field2(:,:,l)=field(:,:,l)/cv(:,:) ; ENDDO 1966 CASE DEFAULT 1967 field2=field 1968 END SELECT 1969 1940 1970 #ifdef NC_DOUBLE 1941 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)1971 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2) 1942 1972 #else 1943 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)1973 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2) 1944 1974 #endif 1945 CASE ("V")1946 ierr = NF_INQ_VARID(nid,"vcov",varid)1947 start=(/1,1,1,timestep/)1948 count=(/iip1,jjm,llm,1/)1949 #ifdef NC_DOUBLE1950 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)1951 #else1952 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)1953 #endif1954 CASE ("T")1955 ierr = NF_INQ_VARID(nid,"teta",varid)1956 start=(/1,1,1,timestep/)1957 count=(/iip1,jjp1,llm,1/)1958 #ifdef NC_DOUBLE1959 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)1960 #else1961 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)1962 #endif1963 CASE ("Q")1964 ierr = NF_INQ_VARID(nid,"q",varid)1965 start=(/1,1,1,timestep/)1966 count=(/iip1,jjp1,llm,1/)1967 #ifdef NC_DOUBLE1968 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)1969 #else1970 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)1971 #endif1972 END SELECT1973 1975 1974 1976 ierr = NF_CLOSE(nid)
Note: See TracChangeset
for help on using the changeset viewer.
