Changeset 3941 for trunk/LMDZ.PLUTO/libf/dynphy_lonlat/phypluto/newstart.F
- Timestamp:
- Oct 29, 2025, 9:10:13 PM (5 weeks ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.PLUTO/libf/dynphy_lonlat/phypluto/newstart.F
r3914 r3941 564 564 565 565 write(*,*) "Enter value of albedo of the bare ground:" 566 write(*,*) "Might not count" 566 567 read(*,*) alb(1,1) 567 568 alb(:,:)=alb(1,1) 568 569 569 570 write(*,*) "Enter value of thermal inertia of soil:" 571 write(*,*) "Might not count" 570 572 read(*,*) surfith(1,1) 571 573 surfith(:,:)=surfith(1,1) … … 599 601 ! copy soil thermal inertia 600 602 ithfi(:,:)=inertiedat(:,:) 603 ! copy topo 604 CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phisold_newgrid,phisfi) 605 ! Initialize n2frac 606 n2fracfi(:)=1. 601 607 602 608 ierr= NF_CLOSE(nid) 603 609 604 610 else if (choix_1.eq.1) then 605 !do nothing, start and startfi have already been read 611 !do nothing, start and startfi have already been read 612 ! Initialize n2frac 613 n2fracfi(:)=1. 606 614 else 607 615 CALL exit(1) … … 1891 1899 533 read(*,*,iostat=ierr) val3 1892 1900 if(ierr.ne.0) goto 533 1893 ! write(*,*) 'iip1,jjp1=',iip1,jjp1,ngridmx 1894 1895 DO ig=1,ngridmx 1901 1902 if (val1.le.0.) then ! Case asym in S. hemisphere 1903 1904 DO ig=1,ngridmx 1896 1905 ! Latitude of the sinusoid: 1897 1906 val11=val1+val2*cos(lonfi(ig)*1.57079633*2/pi-val3*pi/180.) 1898 ! If above line and ice: removeice1907 ! If we are above the sinus line: we remove any ice 1899 1908 IF ( (latfi(ig)*180./pi.ge.val11) .and. 1900 1909 & (latfi(ig)*180./pi.le.val1+val2) .and. 1901 1910 & (qsurf(ig,igcm_n2).gt.0.) ) then 1902 ! Look for same longitude point where no ice 1911 ! Looking for point at same longitude but northward with no ice 1912 ! to apply its surface and soil temperatures 1903 1913 val5=1. 1904 1914 jref=ig … … 1906 1916 ! ... iip1 ... x (jjp1-2) 32 x 23 1907 1917 ! 1 1908 do while (val5.ge.1..and.jref.gt.iip1) 1909 ! northward point1918 do while (val5.ge.1..and.jref.gt.iip1) ! will exit if qsurf=0 1919 ! We take the northward point 1910 1920 jref=jref-iip1+1 1911 ! ice at the point1921 ! We check of ice is present at that point. If not we exit 1912 1922 val5=qsurf(jref,igcm_n2) 1913 ! write(*,*) jref,1914 ! & latfi(jref)*180./pi,lonfi(jref)*180/pi,val51915 1923 enddo 1916 if (val5.ge.1) write(*,*) ' NO POINT FOUND WITH NO ICE'1924 if (val5.ge.1) write(*,*) 'PB NO POINT FOUND WITH NO ICE' 1917 1925 1918 1926 ! Copy point in the selected area … … 1920 1928 qsurf(ig,igcm_n2)=qsurf(jref,igcm_n2) 1921 1929 qsurf(ig,igcm_ch4_ice)=qsurf(jref,igcm_ch4_ice) 1922 qsurf(ig,igcm_co_ice)=qsurf(jref,igcm_co_ice)1930 !qsurf(ig,igcm_co_ice)=qsurf(jref,igcm_co_ice) 1923 1931 DO l=1,nsoilmx 1924 1932 tsoil(ig,l)=tsoil(jref,l) 1925 1933 ENDDO 1926 1934 ENDIF 1927 ! If below line and no ice:add ice1935 ! If we are below the sinus line and there no ice: we add ice 1928 1936 IF ( (latfi(ig)*180./pi.le.val11) .and. 1929 & (latfi(ig)*180./pi. le.val1+val2) .and.1937 & (latfi(ig)*180./pi.ge.val1-val2) .and. 1930 1938 & (qsurf(ig,igcm_n2).eq.0.) ) then 1931 ! Look for same longitude point where ice1932 1939 val5=1. 1933 1940 jref=ig … … 1935 1942 ! southward point 1936 1943 jref=jref+iip1-1 1937 ! ice at the point1944 ! We check of ice is present at that point. If yes we exit 1938 1945 val5=qsurf(jref,igcm_n2) 1939 write(*,*) jref,1940 & latfi(jref)*180./pi,lonfi(jref)*180/pi,val51941 1946 enddo 1942 if (val5.le.1) write(*,*) ' NO POINT FOUND WITH ICE'1947 if (val5.le.1) write(*,*) 'PB NO POINT FOUND WITH ICE' 1943 1948 1944 1949 ! Copy point in the selected area … … 1946 1951 qsurf(ig,igcm_n2)=qsurf(jref,igcm_n2) 1947 1952 qsurf(ig,igcm_ch4_ice)=qsurf(jref,igcm_ch4_ice) 1948 qsurf(ig,igcm_co_ice)=qsurf(jref,igcm_co_ice)1953 !qsurf(ig,igcm_co_ice)=qsurf(jref,igcm_co_ice) 1949 1954 DO l=1,nsoilmx 1950 1955 tsoil(ig,l)=tsoil(jref,l) … … 1952 1957 ENDIF 1953 1958 1954 ENDDO 1959 ENDDO 1960 1961 else ! Case N. hemisphere 1962 1963 DO ig=1,ngridmx 1964 ! Latitude of the sinusoid: 1965 val11=val1+val2*cos(lonfi(ig)*1.57079633*2/pi-val3*pi/180.) 1966 ! If we are below the sinus line: we remove any ice 1967 IF ( (latfi(ig)*180./pi.le.val11) .and. 1968 & (latfi(ig)*180./pi.ge.val1-val2) .and. 1969 & (qsurf(ig,igcm_n2).gt.0.) ) then 1970 ! Looking for point at same longitude but southward with no ice 1971 ! to apply its surface and soil temperatures 1972 val5=1. 1973 jref=ig 1974 ! 1 1975 ! ... iip1 ... x (jjp1-2) 32 x 23 1976 ! 1 1977 do while (val5.ge.1..and.jref.lt.ngridmx-iip1) ! will exit if qsurf=0 1978 ! We take the southward point 1979 jref=jref+iip1-1 1980 ! We check of ice is present at that point. If not we exit 1981 val5=qsurf(jref,igcm_n2) 1982 enddo 1983 if (val5.ge.1) write(*,*) 'PB NO POINT FOUND WITH NO ICE' 1984 1985 ! Copy point in the selected area 1986 tsurf(ig)=tsurf(jref) 1987 qsurf(ig,igcm_n2)=qsurf(jref,igcm_n2) 1988 qsurf(ig,igcm_ch4_ice)=qsurf(jref,igcm_ch4_ice) 1989 !qsurf(ig,igcm_co_ice)=qsurf(jref,igcm_co_ice) 1990 DO l=1,nsoilmx 1991 tsoil(ig,l)=tsoil(jref,l) 1992 ENDDO 1993 ENDIF 1994 ! If we are above the sinus line and there no ice: we add ice 1995 IF ( (latfi(ig)*180./pi.ge.val11) .and. 1996 & (latfi(ig)*180./pi.le.val1+val2) .and. 1997 & (qsurf(ig,igcm_n2).eq.0.) ) then 1998 val5=1. 1999 jref=ig 2000 do while (val5.le.1.and.jref.gt.iip1) 2001 ! northward point 2002 jref=jref-iip1-1 2003 ! We check of ice is present at that point. If yes we exit 2004 val5=qsurf(jref,igcm_n2) 2005 enddo 2006 if (val5.le.1) write(*,*) 'PB NO POINT FOUND WITH ICE' 2007 2008 ! Copy point in the selected area 2009 tsurf(ig)=tsurf(jref) 2010 qsurf(ig,igcm_n2)=qsurf(jref,igcm_n2) 2011 qsurf(ig,igcm_ch4_ice)=qsurf(jref,igcm_ch4_ice) 2012 !qsurf(ig,igcm_co_ice)=qsurf(jref,igcm_co_ice) 2013 DO l=1,nsoilmx 2014 tsoil(ig,l)=tsoil(jref,l) 2015 ENDDO 2016 ENDIF 2017 2018 ENDDO 2019 2020 endif ! Case N. hemisphere 1955 2021 1956 2022 c source_ch4 : adding source ch4
Note: See TracChangeset
for help on using the changeset viewer.
