Changeset 1378 for IOIPSL/trunk/src/restcom.f90
- Timestamp:
- 04/20/11 12:08:00 (13 years ago)
- File:
-
- 1 edited
-
IOIPSL/trunk/src/restcom.f90 (modified) (42 diffs)
Legend:
- Unmodified
- Added
- Removed
-
IOIPSL/trunk/src/restcom.f90
r430 r1378 8 8 USE netcdf 9 9 !- 10 USE errioipsl, ONLY : ipslerr,ipsldbg 10 USE errioipsl, ONLY : ipslerr,ipsldbg, ipslout 11 11 USE stringop 12 12 USE calendar … … 230 230 !- 231 231 IF (l_dbg) THEN 232 WRITE( *,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout)232 WRITE(ipslout,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout) 233 233 ENDIF 234 234 !- … … 254 254 !- 255 255 IF (l_dbg) THEN 256 WRITE( *,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw256 WRITE(ipslout,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw 257 257 ENDIF 258 258 !- … … 261 261 IF (l_fi) THEN 262 262 !--- 263 IF (l_dbg) WRITE( *,*) 'restini 1.0 : Open input file'263 IF (l_dbg) WRITE(ipslout,*) 'restini 1.0 : Open input file' 264 264 !-- Add DOMAIN number and ".nc" suffix in file names if needed 265 265 fname = fnamein … … 284 284 !-- 2.0 The case of a missing restart file is dealt with 285 285 !--- 286 IF (l_dbg) WRITE( *,*) 'restini 2.0'286 IF (l_dbg) WRITE(ipslout,*) 'restini 2.0' 287 287 !--- 288 288 IF ( (ALL(MINLOC(lon(:iim,:jjm)) == MAXLOC(lon(:iim,:jjm)))) & … … 340 340 !- 341 341 IF (l_dbg) THEN 342 WRITE( *,*) 'restini 2.3 : Configure calendar if needed : ', &342 WRITE(ipslout,*) 'restini 2.3 : Configure calendar if needed : ', & 343 343 calend_str 344 344 ENDIF … … 347 347 CALL ioconf_calendar (calend_str) 348 348 IF (l_dbg) THEN 349 WRITE( *,*) 'restini 2.3b : new calendar : ',calend_str349 WRITE(ipslout,*) 'restini 2.3b : new calendar : ',calend_str 350 350 ENDIF 351 351 ENDIF … … 359 359 fid = nb_fi 360 360 IF (l_dbg) THEN 361 WRITE( *,*) 'SIZE of t_index :',SIZE(t_index), &361 WRITE(ipslout,*) 'SIZE of t_index :',SIZE(t_index), & 362 362 SIZE(t_index,dim=1),SIZE(t_index,dim=2) 363 WRITE( *,*) 't_index = ',t_index(fid,:)363 WRITE(ipslout,*) 't_index = ',t_index(fid,:) 364 364 ENDIF 365 365 itau = t_index(fid,1) 366 366 !- 367 IF (l_dbg) WRITE( *,*) 'restini END'367 IF (l_dbg) WRITE(ipslout,*) 'restini END' 368 368 !--------------------- 369 369 END SUBROUTINE restini … … 502 502 ! 2.0 Get the list of variables 503 503 !- 504 IF (l_dbg) WRITE( *,*) 'restopenin 1.2'504 IF (l_dbg) WRITE(ipslout,*) 'restopenin 1.2' 505 505 !- 506 506 lat_vid = -1 … … 663 663 CALL ioconf_calendar (calendar) 664 664 IF (l_dbg) THEN 665 WRITE( *,*) 'restsett : calendar of the restart ',calendar665 WRITE(ipslout,*) 'restsett : calendar of the restart ',calendar 666 666 ENDIF 667 667 ENDIF … … 669 669 CALL ioget_calendar (one_year,one_day) 670 670 IF (l_dbg) THEN 671 WRITE( *,*) 'one_year,one_day = ',one_year,one_day671 WRITE(ipslout,*) 'one_year,one_day = ',one_year,one_day 672 672 ENDIF 673 673 !- … … 681 681 t_index(nb_fi,:) = itau 682 682 IF (l_dbg) THEN 683 WRITE( *,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:)683 WRITE(ipslout,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:) 684 684 ENDIF 685 685 CALL ju2ymds (date0,year0,month0,day0,sec0) … … 691 691 strc=':' 692 692 IF (l_dbg) THEN 693 WRITE( *,*) date0693 WRITE(ipslout,*) date0 694 694 WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') & 695 695 & year0,'-',month0,'-',day0,' ',hours0,':',minutes0,':',seci 696 WRITE( *,*) "itau_orig : ",itau_orig696 WRITE(ipslout,*) "itau_orig : ",itau_orig 697 697 ENDIF 698 698 ELSE 699 699 iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:)) 700 700 IF (l_dbg) THEN 701 WRITE( *,*) "restsett, time axis : ",t_index(nb_fi,:)701 WRITE(ipslout,*) "restsett, time axis : ",t_index(nb_fi,:) 702 702 ENDIF 703 703 iret = NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'units',itau_orig) … … 727 727 iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal) 728 728 IF (l_dbg) THEN 729 WRITE( *,*) 'restsett : tmp_calendar of the restart ',tmp_cal729 WRITE(ipslout,*) 'restsett : tmp_calendar of the restart ',tmp_cal 730 730 ENDIF 731 731 !--- … … 744 744 !-- to get ride of the intial date. 745 745 !--- 746 IF (l_dbg) WRITE( *,*) 'tax_orig : ',TRIM(tax_orig)746 IF (l_dbg) WRITE(ipslout,*) 'tax_orig : ',TRIM(tax_orig) 747 747 READ (UNIT=tax_orig,FMT='(I4.4,5(a,I2.2))') & 748 748 year0,strc,month0,strc,day0,strc, & … … 831 831 CALL ipsldbg (old_status=l_dbg) 832 832 !- 833 IF (l_dbg) WRITE( *,*) "restopenout 0.0 ",TRIM(fname)833 IF (l_dbg) WRITE(ipslout,*) "restopenout 0.0 ",TRIM(fname) 834 834 !- 835 835 ! If we use the same file for input and output … … 863 863 ! 1.0 Longitude 864 864 !- 865 IF (l_dbg) WRITE( *,*) "restopenout 1.0"865 IF (l_dbg) WRITE(ipslout,*) "restopenout 1.0" 866 866 !- 867 867 iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid) … … 873 873 ! 2.0 Latitude 874 874 !- 875 IF (l_dbg) WRITE( *,*) "restopenout 2.0"875 IF (l_dbg) WRITE(ipslout,*) "restopenout 2.0" 876 876 !- 877 877 iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid) … … 883 883 ! 3.0 Levels 884 884 !- 885 IF (l_dbg) WRITE( *,*) "restopenout 3.0"885 IF (l_dbg) WRITE(ipslout,*) "restopenout 3.0" 886 886 !- 887 887 iret = NF90_DEF_VAR(ncfid,"nav_lev",NF90_FLOAT,z_id,nlevid) … … 895 895 ! 4.0 Time axis, this is the seconds since axis 896 896 !- 897 IF (l_dbg) WRITE( *,*) "restopenout 4.0"897 IF (l_dbg) WRITE(ipslout,*) "restopenout 4.0" 898 898 !- 899 899 iret = NF90_DEF_VAR(ncfid,"time",NF90_FLOAT, & … … 923 923 ! 5.0 Time axis, this is the time steps since axis 924 924 !- 925 IF (l_dbg) WRITE( *,*) "restopenout 5.0"925 IF (l_dbg) WRITE(ipslout,*) "restopenout 5.0" 926 926 !- 927 927 iret = NF90_DEF_VAR(ncfid,"time_steps",NF90_INT, & … … 984 984 iret = NF90_REDEF(ncfid) 985 985 !- 986 IF (l_dbg) WRITE( *,*) "restopenout END"986 IF (l_dbg) WRITE(ipslout,*) "restopenout END" 987 987 !------------------------- 988 988 END SUBROUTINE restopenout … … 1902 1902 ! 1.0 Check if the variable is already present 1903 1903 !- 1904 IF (l_dbg) WRITE( *,*) 'RESTPUT 1.0 : ',TRIM(vname_q)1904 IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 1.0 : ',TRIM(vname_q) 1905 1905 !- 1906 1906 CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb) 1907 1907 !- 1908 1908 IF (l_dbg) THEN 1909 WRITE( *,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb1909 WRITE(ipslout,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb 1910 1910 ENDIF 1911 1911 !- … … 1919 1919 vid = varid_out(fid,vnb) 1920 1920 !- 1921 IF (l_dbg) WRITE( *,*) 'RESTPUT 2.0 : ',vnb,vid1921 IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 2.0 : ',vnb,vid 1922 1922 !- 1923 1923 ! 2.1 Is this file already in write mode ? … … 1932 1932 ! If not then check that all variables of previous time is OK. 1933 1933 !- 1934 IF (l_dbg) WRITE( *,*) 'RESTPUT 3.0 : ',itau,itau_out(fid)1934 IF (l_dbg) WRITE(ipslout,*) 'RESTPUT 3.0 : ',itau,itau_out(fid) 1935 1935 !- 1936 1936 IF (itau /= itau_out(fid)) THEN … … 1942 1942 IF (tstp_out(fid) == 0) THEN 1943 1943 IF (nbvar_out(fid) < nbvar_read(fid)) THEN 1944 WRITE( *,*) "ERROR :",tstp_out(fid), &1944 WRITE(ipslout,*) "ERROR :",tstp_out(fid), & 1945 1945 nbvar_out(fid),nbvar_read(fid) 1946 1946 CALL ipslerr (1,'restput', & … … 1955 1955 ENDDO 1956 1956 IF (ierr > 0) THEN 1957 WRITE( *,*) "ERROR :",nbvar_out(fid)1957 WRITE(ipslout,*) "ERROR :",nbvar_out(fid) 1958 1958 CALL ipslerr (1,'restput', & 1959 1959 & 'There are fewer variables in the output file for this', & … … 1971 1971 !--- 1972 1972 IF (l_dbg) THEN 1973 WRITE( *,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1)1973 WRITE(ipslout,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1) 1974 1974 ENDIF 1975 1975 !--- … … 2058 2058 !- 2059 2059 IF (l_dbg) THEN 2060 WRITE( *,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid)2060 WRITE(ipslout,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid) 2061 2061 ENDIF 2062 2062 !- … … 2134 2134 !- 2135 2135 IF (l_dbg) THEN 2136 WRITE( *,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid)2136 WRITE(ipslout,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid) 2137 2137 ENDIF 2138 2138 !- … … 2169 2169 !- 2170 2170 IF (l_dbg) THEN 2171 WRITE( *,*) &2171 WRITE(ipslout,*) & 2172 2172 & 'restdefv 3.0 : LIST OF VARS ',varname_out(fid,1:nbvar_out(fid)) 2173 2173 ENDIF … … 2193 2193 IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian)) THEN 2194 2194 IF (l_msg) THEN 2195 WRITE( *,*) TRIM(c_p)//' : Allocate times axes at :', &2195 WRITE(ipslout,*) TRIM(c_p)//' : Allocate times axes at :', & 2196 2196 & max_file,tax_size_in(nb_fi) 2197 2197 ENDIF … … 2199 2199 ALLOCATE(t_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 2200 2200 IF (i_err/=0) THEN 2201 WRITE( *,*) "ERROR IN ALLOCATION of t_index : ",i_err2201 WRITE(ipslout,*) "ERROR IN ALLOCATION of t_index : ",i_err 2202 2202 CALL ipslerr (3,TRIM(c_p), & 2203 2203 & 'Problem in allocation of t_index','', & … … 2208 2208 ALLOCATE(t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 2209 2209 IF (i_err/=0) THEN 2210 WRITE( *,*) "ERROR IN ALLOCATION of t_julian : ",i_err2210 WRITE(ipslout,*) "ERROR IN ALLOCATION of t_julian : ",i_err 2211 2211 CALL ipslerr (3,TRIM(c_p), & 2212 2212 & 'Problem in allocation of max_file,tax_size_in','', & … … 2217 2217 & .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nb_fi)) ) THEN 2218 2218 IF (l_msg) THEN 2219 WRITE( *,*) TRIM(c_p)//' : Reallocate times axes at :', &2219 WRITE(ipslout,*) TRIM(c_p)//' : Reallocate times axes at :', & 2220 2220 & max_file,tax_size_in(nb_fi) 2221 2221 ENDIF … … 2223 2223 ALLOCATE (tmp_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 2224 2224 IF (i_err/=0) THEN 2225 WRITE( *,*) "ERROR IN ALLOCATION of tmp_index : ",i_err2225 WRITE(ipslout,*) "ERROR IN ALLOCATION of tmp_index : ",i_err 2226 2226 CALL ipslerr (3,TRIM(c_p), & 2227 2227 & 'Problem in allocation of tmp_index','', & … … 2233 2233 ALLOCATE (t_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 2234 2234 IF (i_err/=0) THEN 2235 WRITE( *,*) "ERROR IN ALLOCATION of t_index : ",i_err2235 WRITE(ipslout,*) "ERROR IN ALLOCATION of t_index : ",i_err 2236 2236 CALL ipslerr (3,TRIM(c_p), & 2237 2237 & 'Problem in reallocation of t_index','', & … … 2242 2242 ALLOCATE (tmp_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 2243 2243 IF (i_err/=0) THEN 2244 WRITE( *,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err2244 WRITE(ipslout,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err 2245 2245 CALL ipslerr (3,TRIM(c_p), & 2246 2246 & 'Problem in allocation of tmp_julian','', & … … 2252 2252 ALLOCATE (t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 2253 2253 IF (i_err/=0) THEN 2254 WRITE( *,*) "ERROR IN ALLOCATION of t_julian : ",i_err2254 WRITE(ipslout,*) "ERROR IN ALLOCATION of t_julian : ",i_err 2255 2255 CALL ipslerr (3,TRIM(c_p), & 2256 2256 & 'Problem in reallocation of t_julian','', & … … 2308 2308 IF ( (l_alloc1.AND.ALLOCATED(buff_tmp1)) & 2309 2309 & .OR.(l_alloc2.AND.ALLOCATED(buff_tmp2)) ) THEN 2310 WRITE( *,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz2310 WRITE(ipslout,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz 2311 2311 ELSE 2312 WRITE( *,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz2312 WRITE(ipslout,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz 2313 2313 ENDIF 2314 2314 ENDIF … … 2479 2479 !--- 2480 2480 IF (l_dbg) THEN 2481 WRITE( *,*) &2481 WRITE(ipslout,*) & 2482 2482 'restclo : Closing specified restart file number :', & 2483 2483 fid,netcdf_id(fid,1:2) … … 2511 2511 ELSE 2512 2512 !--- 2513 IF (l_dbg) WRITE( *,*) 'restclo : Closing all files'2513 IF (l_dbg) WRITE(ipslout,*) 'restclo : Closing all files' 2514 2514 !--- 2515 2515 DO ifnc=1,nb_fi
Note: See TracChangeset
for help on using the changeset viewer.
