Changeset 5100
- Timestamp:
- Jul 23, 2024, 7:00:20 AM (7 weeks ago)
- Location:
- LMDZ6/branches/Amaury_dev
- Files:
-
- 28 edited
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90
r5099 r5100 8 8 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName 9 9 USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str 10 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, &11 NF90_CLOSE, nf90_get_var, nf90_noerr10 USE netcdf, ONLY: nf90_open, nf90_nowrite, NF90_INQ_VARID, & 11 nf90_close, nf90_get_var, nf90_noerr 12 12 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey 13 13 USE control_mod, ONLY: planet_type … … 50 50 !--- Initial state file opening 51 51 var=fichnom 52 CALL err( NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)52 CALL err(nf90_open(var,nf90_nowrite,fID),"open",var) 53 53 CALL get_var1("controle",tab_cntrl) 54 54 … … 188 188 END DO 189 189 190 CALL err( NF90_CLOSE(fID),"close",fichnom)190 CALL err(nf90_close(fID),"close",fichnom) 191 191 day_ini=day_ini+INT(time) 192 192 time=time-INT(time) -
LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem.F90
r5099 r5100 9 9 USE strings_mod, ONLY: maxlen 10 10 USE infotrac, ONLY: nqtot, tracers 11 USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL, &12 NF90_CLOSE, NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER, &13 NF90_64BIT_OFFSET11 USE netcdf, ONLY: nf90_create, nf90_def_dim, NF90_INQ_VARID, nf90_global, & 12 nf90_close, nf90_put_att, nf90_unlimited, nf90_clobber, & 13 nf90_64bit_offset 14 14 USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil 15 15 USE comvert_mod, ONLY: ap, bp, presnivs, pa, preff, nivsig, nivsigs … … 105 105 106 106 !--- File creation 107 CALL err( NF90_CREATE(fichnom,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET),nid))107 CALL err(nf90_create(fichnom,IOR(nf90_clobber,nf90_64bit_offset),nid)) 108 108 109 109 !--- Some global attributes 110 CALL err( NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))110 CALL err(nf90_put_att(nid,nf90_global,"title","Fichier demarrage dynamique")) 111 111 112 112 !--- Dimensions 113 CALL err( NF90_DEF_DIM(nid,"index", length, indexID))114 CALL err( NF90_DEF_DIM(nid,"rlonu", iip1, rlonuID))115 CALL err( NF90_DEF_DIM(nid,"rlatu", jjp1, rlatuID))116 CALL err( NF90_DEF_DIM(nid,"rlonv", iip1, rlonvID))117 CALL err( NF90_DEF_DIM(nid,"rlatv", jjm, rlatvID))118 CALL err( NF90_DEF_DIM(nid,"sigs", llm, sID))119 CALL err( NF90_DEF_DIM(nid,"sig", llmp1, sigID))120 CALL err( NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))113 CALL err(nf90_def_dim(nid,"index", length, indexID)) 114 CALL err(nf90_def_dim(nid,"rlonu", iip1, rlonuID)) 115 CALL err(nf90_def_dim(nid,"rlatu", jjp1, rlatuID)) 116 CALL err(nf90_def_dim(nid,"rlonv", iip1, rlonvID)) 117 CALL err(nf90_def_dim(nid,"rlatv", jjm, rlatvID)) 118 CALL err(nf90_def_dim(nid,"sigs", llm, sID)) 119 CALL err(nf90_def_dim(nid,"sig", llmp1, sigID)) 120 CALL err(nf90_def_dim(nid,"temps", nf90_unlimited, timID)) 121 121 122 122 !--- Define and save invariant fields … … 149 149 CALL cre_var(nid,"masse","Masse d air" ,[rlonvID,rlatuID,sID,timID]) 150 150 CALL cre_var(nid,"ps" ,"Pression au sol",[rlonvID,rlatuID ,timID]) 151 CALL err( NF90_CLOSE(nid))151 CALL err(nf90_close (nid)) 152 152 153 153 WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end … … 169 169 USE infotrac, ONLY: nqtot, tracers, type_trac 170 170 USE control_mod 171 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, nf90_get_var, NF90_INQ_VARID, &172 NF90_CLOSE, NF90_WRITE, NF90_PUT_VAR, nf90_noerr171 USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_get_var, NF90_INQ_VARID, & 172 nf90_close, NF90_WRITE, nf90_put_var, nf90_noerr 173 173 USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, & 174 174 err, modname, fil, msg … … 202 202 203 203 modname='dynredem1'; fil=fichnom 204 CALL err( NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)204 CALL err(nf90_open(fil,NF90_WRITE,nid),"open",fil) 205 205 206 206 !--- Write/extend time coordinate … … 208 208 var="temps" 209 209 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 210 CALL err( NF90_PUT_VAR(nid,vID,[time]),"put",var)210 CALL err(nf90_put_var(nid,vID,[time]),"put",var) 211 211 WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time 212 212 … … 217 217 tab_cntrl(31)=DBLE(itau_dyn + itaufin) 218 218 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 219 CALL err( NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)219 CALL err(nf90_put_var(nid,vID,tab_cntrl),"put",var) 220 220 221 221 !--- Save fields … … 229 229 lread_inca=.FALSE.; fil="start_trac.nc" 230 230 IF(ANY(type_trac == ['inca','inco'])) INQUIRE(FILE=fil,EXIST=lread_inca) 231 IF(lread_inca) CALL err( NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")231 IF(lread_inca) CALL err(nf90_open(fil,nf90_nowrite,nid_trac),"open") 232 232 233 233 !--- Save tracers … … 245 245 CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm) 246 246 END DO 247 CALL err( NF90_CLOSE(nid),"close")247 CALL err(nf90_close(nid),"close") 248 248 fil="start_trac.nc" 249 IF(lread_inca) CALL err( NF90_CLOSE(nid_trac),"close")249 IF(lread_inca) CALL err(nf90_close(nid_trac),"close") 250 250 251 251 END SUBROUTINE dynredem1 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem_mod.F90
r5099 r5100 32 32 start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1] 33 33 CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) 34 CALL err( NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)34 CALL err(nf90_put_var(ncid,nvarid,var,start,count),"put",id) 35 35 36 36 END SUBROUTINE dynredem_write_u … … 55 55 start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1] 56 56 CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) 57 CALL err( NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)57 CALL err(nf90_put_var(ncid,nvarid,var,start,count),"put",id) 58 58 59 59 END SUBROUTINE dynredem_write_v … … 96 96 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units 97 97 !=============================================================================== 98 CALL err( NF90_DEF_VAR(ncid,var,nf90_format,did,nvarid),"inq",var)99 IF(title/="") CALL err( NF90_PUT_ATT(ncid,nvarid,"title",title),var)100 IF(PRESENT(units)) CALL err( NF90_PUT_ATT(ncid,nvarid,"units",units),var)98 CALL err(nf90_def_var(ncid,var,nf90_format,did,nvarid),"inq",var) 99 IF(title/="") CALL err(nf90_put_att(ncid,nvarid,"title",title),var) 100 IF(PRESENT(units)) CALL err(nf90_put_att(ncid,nvarid,"units",units),var) 101 101 102 102 END SUBROUTINE cre_var … … 119 119 IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) 120 120 IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) 121 CALL err( NF90_ENDDEF(ncid))122 CALL err( NF90_PUT_VAR(ncid,nvarid,v),"put",var)121 CALL err(nf90_enddef(ncid)) 122 CALL err(nf90_put_var(ncid,nvarid,v),"put",var) 123 123 CALL err(NF90_REDEF(ncid)) 124 124 … … 142 142 IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) 143 143 IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) 144 CALL err( NF90_ENDDEF(ncid))145 CALL err( NF90_PUT_VAR(ncid,nvarid,v),"put",var)144 CALL err(nf90_enddef(ncid)) 145 CALL err(nf90_put_var(ncid,nvarid,v),"put",var) 146 146 CALL err(NF90_REDEF(ncid)) 147 147 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/guide_mod.F90
r5099 r5100 175 175 if (guide_plevs==1) then 176 176 if (ncidpl==-99) then 177 rcod=nf90_open('apbp.nc', Nf90_NOWRITe, ncidpl)177 rcod=nf90_open('apbp.nc',nf90_nowrite, ncidpl) 178 178 if (rcod/=nf90_noerr) THEN 179 179 abort_message=' Nudging error -> no file apbp.nc' … … 183 183 elseif (guide_plevs==2) then 184 184 if (ncidpl==-99) then 185 rcod=nf90_open('P.nc', Nf90_NOWRITe,ncidpl)185 rcod=nf90_open('P.nc',nf90_nowrite,ncidpl) 186 186 if (rcod/=nf90_noerr) THEN 187 187 abort_message=' Nudging error -> no file P.nc' … … 192 192 elseif (guide_u) then 193 193 if (ncidpl==-99) then 194 rcod=nf90_open('u.nc', Nf90_NOWRITe,ncidpl)194 rcod=nf90_open('u.nc',nf90_nowrite,ncidpl) 195 195 if (rcod/=nf90_noerr) THEN 196 196 CALL abort_gcm(modname, & … … 1690 1690 1691 1691 ! Creation des variables dimensions 1692 ierr= NF90_DEF_VAR(nid,"LONU",NF90_FLOAT,id_lonu,vid_lonu)1693 ierr= NF90_DEF_VAR(nid,"LONV",NF90_FLOAT,id_lonv,vid_lonv)1694 ierr= NF90_DEF_VAR(nid,"LATU",NF90_FLOAT,id_latu,vid_latu)1695 ierr= NF90_DEF_VAR(nid,"LATV",NF90_FLOAT,id_latv,vid_latv)1696 ierr= NF90_DEF_VAR(nid,"LEVEL",NF90_FLOAT,id_lev,vid_lev)1697 ierr= NF90_DEF_VAR(nid,"cu",NF90_FLOAT,(/id_lonu,id_latu/),vid_cu)1698 ierr= NF90_DEF_VAR(nid,"cv",NF90_FLOAT,(/id_lonv,id_latv/),vid_cv)1699 ierr= NF90_DEF_VAR(nid,"au",NF90_FLOAT,(/id_lonu,id_latu/),vid_au)1700 ierr= NF90_DEF_VAR(nid,"av",NF90_FLOAT,(/id_lonv,id_latv/),vid_av)1692 ierr=nf90_def_var(nid,"LONU",nf90_float,id_lonu,vid_lonu) 1693 ierr=nf90_def_var(nid,"LONV",nf90_float,id_lonv,vid_lonv) 1694 ierr=nf90_def_var(nid,"LATU",nf90_float,id_latu,vid_latu) 1695 ierr=nf90_def_var(nid,"LATV",nf90_float,id_latv,vid_latv) 1696 ierr=nf90_def_var(nid,"LEVEL",nf90_float,id_lev,vid_lev) 1697 ierr=nf90_def_var(nid,"cu",nf90_float,(/id_lonu,id_latu/),vid_cu) 1698 ierr=nf90_def_var(nid,"cv",nf90_float,(/id_lonv,id_latv/),vid_cv) 1699 ierr=nf90_def_var(nid,"au",nf90_float,(/id_lonu,id_latu/),vid_au) 1700 ierr=nf90_def_var(nid,"av",nf90_float,(/id_lonv,id_latv/),vid_av) 1701 1701 call nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), & 1702 1702 varid_alpha_t) … … 1724 1724 ! Pressure (GCM) 1725 1725 dim4=(/id_lonv,id_latu,id_lev,id_tim/) 1726 ierr = NF90_DEF_VAR(nid,"SP",NF90_FLOAT,dim4,varid)1726 ierr = nf90_def_var(nid,"SP",nf90_float,dim4,varid) 1727 1727 ! Surface pressure (guidage) 1728 1728 IF (guide_P) THEN 1729 1729 dim3=(/id_lonv,id_latu,id_tim/) 1730 ierr = NF90_DEF_VAR(nid,"ps",NF90_FLOAT,dim3,varid)1730 ierr = nf90_def_var(nid,"ps",nf90_float,dim3,varid) 1731 1731 ENDIF 1732 1732 ! Zonal wind 1733 1733 IF (guide_u) THEN 1734 1734 dim4=(/id_lonu,id_latu,id_lev,id_tim/) 1735 ierr = NF90_DEF_VAR(nid,"u",NF90_FLOAT,dim4,varid)1736 ierr = NF90_DEF_VAR(nid,"ua",NF90_FLOAT,dim4,varid)1737 ierr = NF90_DEF_VAR(nid,"ucov",NF90_FLOAT,dim4,varid)1735 ierr = nf90_def_var(nid,"u",nf90_float,dim4,varid) 1736 ierr = nf90_def_var(nid,"ua",nf90_float,dim4,varid) 1737 ierr = nf90_def_var(nid,"ucov",nf90_float,dim4,varid) 1738 1738 ENDIF 1739 1739 ! Merid. wind 1740 1740 IF (guide_v) THEN 1741 1741 dim4=(/id_lonv,id_latv,id_lev,id_tim/) 1742 ierr = NF90_DEF_VAR(nid,"v",NF90_FLOAT,dim4,varid)1743 ierr = NF90_DEF_VAR(nid,"va",NF90_FLOAT,dim4,varid)1744 ierr = NF90_DEF_VAR(nid,"vcov",NF90_FLOAT,dim4,varid)1742 ierr = nf90_def_var(nid,"v",nf90_float,dim4,varid) 1743 ierr = nf90_def_var(nid,"va",nf90_float,dim4,varid) 1744 ierr = nf90_def_var(nid,"vcov",nf90_float,dim4,varid) 1745 1745 ENDIF 1746 1746 ! Pot. Temperature 1747 1747 IF (guide_T) THEN 1748 1748 dim4=(/id_lonv,id_latu,id_lev,id_tim/) 1749 ierr = NF90_DEF_VAR(nid,"teta",NF90_FLOAT,dim4,varid)1749 ierr = nf90_def_var(nid,"teta",nf90_float,dim4,varid) 1750 1750 ENDIF 1751 1751 ! Specific Humidity 1752 1752 IF (guide_Q) THEN 1753 1753 dim4=(/id_lonv,id_latu,id_lev,id_tim/) 1754 ierr = NF90_DEF_VAR(nid,"q",NF90_FLOAT,dim4,varid)1754 ierr = nf90_def_var(nid,"q",nf90_float,dim4,varid) 1755 1755 ENDIF 1756 1756 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/iniacademic.F90
r5099 r5100 22 22 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 23 23 USE readTracFiles_mod, ONLY: addPhase 24 use netcdf, only : NF90_NOWRITE,NF90_OPEN,nf90_noerr,NF90_INQ_VARID,NF90_CLOSE,nf90_get_var24 use netcdf, only : nf90_nowrite,nf90_open,nf90_noerr,NF90_INQ_VARID,nf90_close,nf90_get_var 25 25 26 26 ! Author: Frederic Hourdin original: 15/01/93 … … 140 140 141 141 relief=0. 142 ierr = NF90_OPEN ('relief_in.nc', NF90_NOWRITE,nid_relief)142 ierr = nf90_open ('relief_in.nc', nf90_nowrite,nid_relief) 143 143 if (ierr==nf90_noerr) THEN 144 144 ierr=NF90_INQ_VARID(nid_relief,'RELIEF',varid) … … 150 150 endif 151 151 endif 152 ierr = NF90_CLOSE(nid_relief)152 ierr = nf90_close (nid_relief) 153 153 154 154 !------------------------------------------------------------------ -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90
r5099 r5100 122 122 !------------------------- 123 123 ! Longitudes on "u" dynamical grid 124 status= NF90_DEF_VAR(ncid_out,'lonu',NF90_FLOAT,out_lonudim, out_lonuid)124 status=nf90_def_var(ncid_out,'lonu',nf90_float,out_lonudim, out_lonuid) 125 125 CALL handle_err(status) 126 126 status=nf90_put_att(ncid_out,out_lonuid,'units','degrees_east') 127 127 status=nf90_put_att(ncid_out,out_lonuid,'long_name','Longitude on u grid') 128 128 ! Longitudes on "v" dynamical grid 129 status= NF90_DEF_VAR(ncid_out,'lonv',NF90_FLOAT,out_lonvdim, out_lonvid)129 status=nf90_def_var(ncid_out,'lonv',nf90_float,out_lonvdim, out_lonvid) 130 130 CALL handle_err(status) 131 131 status=nf90_put_att(ncid_out,out_lonvid,'units','degrees_east') 132 132 status=nf90_put_att(ncid_out,out_lonvid,'long_name','Longitude on v grid') 133 133 ! Latitudes on "u" dynamical grid 134 status= NF90_DEF_VAR(ncid_out,'latu',NF90_FLOAT,out_latudim, out_latuid)134 status=nf90_def_var(ncid_out,'latu',nf90_float,out_latudim, out_latuid) 135 135 CALL handle_err(status) 136 136 status=nf90_put_att(ncid_out,out_latuid,'units','degrees_north') 137 137 status=nf90_put_att(ncid_out,out_latuid,'long_name','Latitude on u grid') 138 138 ! Latitudes on "v" dynamical grid 139 status= NF90_DEF_VAR(ncid_out,'latv',NF90_FLOAT,out_latvdim, out_latvid)139 status=nf90_def_var(ncid_out,'latv',nf90_float,out_latvdim, out_latvid) 140 140 CALL handle_err(status) 141 141 status=nf90_put_att(ncid_out,out_latvid,'units','degrees_north') … … 144 144 out_dim(1)=out_lonudim 145 145 out_dim(2)=out_latudim 146 status= NF90_DEF_VAR(ncid_out,'grille_u',NF90_FLOAT,out_dim, out_uid)146 status=nf90_def_var(ncid_out,'grille_u',nf90_float,out_dim, out_uid) 147 147 CALL handle_err(status) 148 148 status=nf90_put_att(ncid_out,out_uid,'units','m/s') … … 151 151 out_dim(1)=out_lonvdim 152 152 out_dim(2)=out_latvdim 153 status= NF90_DEF_VAR(ncid_out,'grille_v',NF90_FLOAT,out_dim, out_vid)153 status=nf90_def_var(ncid_out,'grille_v',nf90_float,out_dim, out_vid) 154 154 CALL handle_err(status) 155 155 status=nf90_put_att(ncid_out,out_vid,'units','m/s') … … 158 158 out_dim(1)=out_lonvdim 159 159 out_dim(2)=out_latudim 160 status= NF90_DEF_VAR(ncid_out,'grille_s',NF90_FLOAT,out_dim, out_tempid)160 status=nf90_def_var(ncid_out,'grille_s',nf90_float,out_dim, out_tempid) 161 161 CALL handle_err(status) 162 162 status=nf90_put_att(ncid_out,out_tempid,'units','Kelvin') … … 165 165 ! for INCA : 166 166 ! vertical levels "presnivs" 167 status= NF90_DEF_VAR(ncid_out,'presnivs',NF90_FLOAT,out_levdim, presnivs_id)167 status=nf90_def_var(ncid_out,'presnivs',nf90_float,out_levdim, presnivs_id) 168 168 CALL handle_err(status) 169 169 status=nf90_put_att(ncid_out,presnivs_id,'units','Pa') … … 172 172 out_dim(1)=out_lonvdim 173 173 out_dim(2)=out_latudim 174 status = nf90_def_var(ncid_out,'phis', NF90_FLOAT,out_dim,phis_id)174 status = nf90_def_var(ncid_out,'phis',nf90_float,out_dim,phis_id) 175 175 CALL handle_err(status) 176 176 status=nf90_put_att(ncid_out,phis_id,'units','m') 177 177 status=nf90_put_att(ncid_out,phis_id,'long_name','surface geopotential height') 178 178 ! gridcell area 179 status = nf90_def_var(ncid_out,'aire', NF90_FLOAT,out_dim,area_id)179 status = nf90_def_var(ncid_out,'aire',nf90_float,out_dim,area_id) 180 180 CALL handle_err(status) 181 181 status=nf90_put_att(ncid_out,area_id,'units','m2') … … 193 193 !------------------------- 194 194 ! 1D : lonu, lonv,latu,latv ; INCA : presnivs 195 status= NF90_PUT_VAR(ncid_out,out_lonuid,rlonudeg,[1],[iip1])196 CALL handle_err(status) 197 status= NF90_PUT_VAR(ncid_out,out_lonvid,rlonvdeg,[1],[iip1])198 CALL handle_err(status) 199 status= NF90_PUT_VAR(ncid_out,out_latuid,rlatudeg,[1],[jjp1])200 CALL handle_err(status) 201 status= NF90_PUT_VAR(ncid_out,out_latvid,rlatvdeg,[1],[jjm])202 CALL handle_err(status) 203 status= NF90_PUT_VAR(ncid_out,presnivs_id,rlev,[1],[llm])195 status=nf90_put_var(ncid_out,out_lonuid,rlonudeg,[1],[iip1]) 196 CALL handle_err(status) 197 status=nf90_put_var(ncid_out,out_lonvid,rlonvdeg,[1],[iip1]) 198 CALL handle_err(status) 199 status=nf90_put_var(ncid_out,out_latuid,rlatudeg,[1],[jjp1]) 200 CALL handle_err(status) 201 status=nf90_put_var(ncid_out,out_latvid,rlatvdeg,[1],[jjm]) 202 CALL handle_err(status) 203 status=nf90_put_var(ncid_out,presnivs_id,rlev,[1],[llm]) 204 204 CALL handle_err(status) 205 205 … … 209 209 210 210 COUNT(2)=jjp1 ! for "u" and "s" grids 211 status= NF90_PUT_VAR(ncid_out,out_uid,uwnd,start, count)211 status=nf90_put_var(ncid_out,out_uid,uwnd,start, count) 212 212 CALL handle_err(status) 213 213 COUNT(2)=jjm ! for "v" grid 214 status= NF90_PUT_VAR(ncid_out,out_vid,vwnd,start, count)214 status=nf90_put_var(ncid_out,out_vid,vwnd,start, count) 215 215 CALL handle_err(status) 216 216 COUNT(2)=jjp1 ! as "s" grid, for all the following vars 217 status= NF90_PUT_VAR(ncid_out,out_tempid,temp,start, count)217 status=nf90_put_var(ncid_out,out_tempid,temp,start, count) 218 218 CALL handle_err(status) 219 219 status = nf90_put_var(ncid_out, phis_id, phis_loc,start,count) -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90
r5099 r5100 9 9 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName 10 10 USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx 11 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, nf90_inquire_dimension, NF90_INQ_VARID, &12 NF90_CLOSE, nf90_get_var, NF90_INQUIRE_VARIABLE, nf90_noerr11 USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_inquire_dimension, NF90_INQ_VARID, & 12 nf90_close, nf90_get_var, NF90_INQUIRE_VARIABLE, nf90_noerr 13 13 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey 14 14 USE control_mod, ONLY: planet_type … … 55 55 !--- Initial state file opening 56 56 var=fichnom 57 CALL err( NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)57 CALL err(nf90_open(var,nf90_nowrite,fID),"open",var) 58 58 CALL get_var1("controle",tab_cntrl) 59 59 … … 215 215 END DO 216 216 DEALLOCATE(q_glo) 217 CALL err( NF90_CLOSE(fID),"close",fichnom)217 CALL err(nf90_close(fID),"close",fichnom) 218 218 day_ini=day_ini+INT(time) 219 219 time=time-INT(time) -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90
r5099 r5100 11 11 USE strings_mod, ONLY: maxlen 12 12 USE infotrac, ONLY: nqtot, tracers 13 USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL, &14 NF90_CLOSE, NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER, &15 NF90_64BIT_OFFSET13 USE netcdf, ONLY: nf90_create, nf90_def_dim, NF90_INQ_VARID, nf90_global, & 14 nf90_close, nf90_put_att, nf90_unlimited, nf90_clobber, & 15 nf90_64bit_offset 16 16 USE dynredem_mod, ONLY: cre_var, put_var, err, modname, fil 17 17 USE comvert_mod, ONLY: ap, bp, presnivs, pa, preff, nivsig, nivsigs,& … … 112 112 113 113 !--- File creation 114 CALL err( NF90_CREATE(fichnom,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET),nid))114 CALL err(nf90_create(fichnom,IOR(nf90_clobber,nf90_64bit_offset),nid)) 115 115 116 116 !--- Some global attributes 117 CALL err( NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))117 CALL err(nf90_put_att(nid,nf90_global,"title","Fichier demarrage dynamique")) 118 118 119 119 !--- Dimensions 120 CALL err( NF90_DEF_DIM(nid,"index", length, indexID))121 CALL err( NF90_DEF_DIM(nid,"rlonu", iip1, rlonuID))122 CALL err( NF90_DEF_DIM(nid,"rlatu", jjp1, rlatuID))123 CALL err( NF90_DEF_DIM(nid,"rlonv", iip1, rlonvID))124 CALL err( NF90_DEF_DIM(nid,"rlatv", jjm, rlatvID))125 CALL err( NF90_DEF_DIM(nid,"sigs", llm, sID))126 CALL err( NF90_DEF_DIM(nid,"sig", llmp1, sigID))127 CALL err( NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))120 CALL err(nf90_def_dim(nid,"index", length, indexID)) 121 CALL err(nf90_def_dim(nid,"rlonu", iip1, rlonuID)) 122 CALL err(nf90_def_dim(nid,"rlatu", jjp1, rlatuID)) 123 CALL err(nf90_def_dim(nid,"rlonv", iip1, rlonvID)) 124 CALL err(nf90_def_dim(nid,"rlatv", jjm, rlatvID)) 125 CALL err(nf90_def_dim(nid,"sigs", llm, sID)) 126 CALL err(nf90_def_dim(nid,"sig", llmp1, sigID)) 127 CALL err(nf90_def_dim(nid,"temps", nf90_unlimited, timID)) 128 128 129 129 !--- Define and save invariant fields … … 156 156 CALL cre_var(nid,"masse","Masse d air" ,[rlonvID,rlatuID,sID,timID]) 157 157 CALL cre_var(nid,"ps" ,"Pression au sol",[rlonvID,rlatuID ,timID]) 158 CALL err( NF90_CLOSE(nid))158 CALL err(nf90_close (nid)) 159 159 160 160 WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end … … 178 178 USE infotrac, ONLY: nqtot, tracers, type_trac 179 179 USE control_mod 180 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, nf90_get_var, NF90_INQ_VARID, &181 NF90_CLOSE, NF90_WRITE, NF90_PUT_VAR, nf90_noerr180 USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_get_var, NF90_INQ_VARID, & 181 nf90_close, NF90_WRITE, nf90_put_var, nf90_noerr 182 182 USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, & 183 183 err, modname, fil, msg … … 213 213 IF(mpi_rank==0) THEN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 214 214 modname='dynredem1_loc'; fil=fichnom 215 CALL err( NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)215 CALL err(nf90_open(fil,NF90_WRITE,nid),"open",fil) 216 216 217 217 !--- Write/extend time coordinate … … 219 219 var="temps" 220 220 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 221 CALL err( NF90_PUT_VAR(nid,vID,[time]),"put",var)221 CALL err(nf90_put_var(nid,vID,[time]),"put",var) 222 222 WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time 223 223 … … 228 228 tab_cntrl(31)=DBLE(itau_dyn + itaufin) 229 229 CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var) 230 CALL err( NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)230 CALL err(nf90_put_var(nid,vID,tab_cntrl),"put",var) 231 231 END IF !++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 232 232 !$OMP END MASTER … … 244 244 fil="start_trac.nc" 245 245 IF(ANY(type_trac == ['inca','inco'])) INQUIRE(FILE=fil,EXIST=lread_inca) 246 IF(lread_inca) CALL err( NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")246 IF(lread_inca) CALL err(nf90_open(fil,nf90_nowrite,nid_trac),"open") 247 247 !$OMP END MASTER 248 248 !$OMP BARRIER … … 266 266 !$OMP MASTER 267 267 IF(mpi_rank==0) THEN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 268 CALL err( NF90_CLOSE(nid),"close")268 CALL err(nf90_close(nid),"close") 269 269 fil="start_trac.nc" 270 IF(lread_inca) CALL err( NF90_CLOSE(nid_trac),"close")270 IF(lread_inca) CALL err(nf90_close(nid_trac),"close") 271 271 END IF !++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 272 272 !$OMP END MASTER -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_mod.F90
r5099 r5100 52 52 !$OMP MASTER 53 53 start(3)=l 54 CALL err( NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)54 CALL err(nf90_put_var(ncid,nvarid,var_glo,start,count),"put",id) 55 55 !$OMP END MASTER 56 56 END IF … … 102 102 !$OMP MASTER 103 103 start(3)=l 104 CALL err( NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)104 CALL err(nf90_put_var(ncid,nvarid,var_glo,start,count),"put",id) 105 105 !$OMP END MASTER 106 106 END IF … … 182 182 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units 183 183 !=============================================================================== 184 CALL err( NF90_DEF_VAR(ncid,var,nf90_format,did,nvarid),"inq",var)185 IF(title/="") CALL err( NF90_PUT_ATT(ncid,nvarid,"title",title),var)186 IF(PRESENT(units)) CALL err( NF90_PUT_ATT(ncid,nvarid,"units",units),var)184 CALL err(nf90_def_var(ncid,var,nf90_format,did,nvarid),"inq",var) 185 IF(title/="") CALL err(nf90_put_att(ncid,nvarid,"title",title),var) 186 IF(PRESENT(units)) CALL err(nf90_put_att(ncid,nvarid,"units",units),var) 187 187 188 188 END SUBROUTINE cre_var … … 208 208 IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) 209 209 IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) 210 CALL err( NF90_ENDDEF(ncid))210 CALL err(nf90_enddef(ncid)) 211 211 nd=SIZE(did) 212 212 DO k=1,nd; CALL err(nf90_inquire_dimension(ncid,did(k),len=nn(k))); END DO 213 IF(nd==1) CALL err( NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:1))),var)214 IF(nd==2) CALL err( NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:2))),var)213 IF(nd==1) CALL err(nf90_put_var(ncid,nvarid,RESHAPE(v,nn(1:1))),var) 214 IF(nd==2) CALL err(nf90_put_var(ncid,nvarid,RESHAPE(v,nn(1:2))),var) 215 215 CALL err(NF90_REDEF(ncid)) 216 216 END SUBROUTINE put_var -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90
r5099 r5100 175 175 if (guide_plevs==1) then 176 176 if (ncidpl==-99) then 177 rcod=nf90_open('apbp.nc', Nf90_NOWRITe, ncidpl)177 rcod=nf90_open('apbp.nc',nf90_nowrite, ncidpl) 178 178 if (rcod/=nf90_noerr) THEN 179 179 abort_message=' Nudging error -> no file apbp.nc' … … 183 183 elseif (guide_plevs==2) then 184 184 if (ncidpl==-99) then 185 rcod=nf90_open('P.nc', Nf90_NOWRITe,ncidpl)185 rcod=nf90_open('P.nc',nf90_nowrite,ncidpl) 186 186 if (rcod/=nf90_noerr) THEN 187 187 abort_message=' Nudging error -> no file P.nc' … … 192 192 elseif (guide_u) then 193 193 if (ncidpl==-99) then 194 rcod=nf90_open('u.nc', Nf90_NOWRITe,ncidpl)194 rcod=nf90_open('u.nc',nf90_nowrite,ncidpl) 195 195 if (rcod/=nf90_noerr) THEN 196 196 abort_message=' Nudging error -> no file u.nc' -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90
r5099 r5100 23 23 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 24 24 USE readTracFiles_mod, ONLY: addPhase 25 use netcdf, only : NF90_NOWRITE,NF90_OPEN,nf90_noerr,NF90_INQ_VARID,NF90_CLOSE, nf90_get_var25 use netcdf, only : nf90_nowrite,nf90_open,nf90_noerr,NF90_INQ_VARID,nf90_close, nf90_get_var 26 26 27 27 ! Author: Frederic Hourdin original: 15/01/93 … … 152 152 153 153 relief=0. 154 ierr = NF90_OPEN ('relief_in.nc', NF90_NOWRITE,nid_relief)154 ierr = nf90_open ('relief_in.nc', nf90_nowrite,nid_relief) 155 155 if (ierr==nf90_noerr) THEN 156 156 ierr=NF90_INQ_VARID(nid_relief,'RELIEF',varid) … … 162 162 endif 163 163 endif 164 ierr = NF90_CLOSE(nid_relief)164 ierr = nf90_close (nid_relief) 165 165 166 166 -
LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/ce0l.F90
r5099 r5100 21 21 USE etat0phys, ONLY: etat0phys_netcdf 22 22 USE limit, ONLY: limit_netcdf 23 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, nf90_noerr, &23 USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_close, nf90_noerr, & 24 24 nf90_inquire_dimension, nf90_inq_dimid, NF90_INQ_VARID, nf90_get_var 25 25 USE infotrac, ONLY: init_infotrac … … 154 154 ! weights to ensure ocean fractions are the same for atmosphere and ocean. 155 155 !******************************************************************************* 156 IF( NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)==nf90_noerr) THEN157 iret= NF90_CLOSE(nid_o2a)156 IF(nf90_open("o2a.nc", nf90_nowrite, nid_o2a)==nf90_noerr) THEN 157 iret=nf90_close(nid_o2a) 158 158 WRITE(lunout,*)'BEWARE !! Ocean mask "o2a.nc" file found' 159 159 WRITE(lunout,*)'Coupled run.' … … 188 188 masque(iip1 ,:)=masque(1,:) 189 189 DEALLOCATE(ocemask) 190 ELSE IF( NF90_OPEN("startphy0.nc", NF90_NOWRITE, nid_sta)==nf90_noerr) THEN190 ELSE IF(nf90_open("startphy0.nc", nf90_nowrite, nid_sta)==nf90_noerr) THEN 191 191 WRITE(lunout,*)'BEWARE !! File "startphy0.nc" found.' 192 192 WRITE(lunout,*)'Getting the land mask from a previous run.' … … 196 196 WRITE(lunout,*)'Mismatching dimensions for land mask' 197 197 WRITE(lunout,*)'nphys = ',nphys ,' klon = ',klon 198 iret= NF90_CLOSE(nid_sta)198 iret=nf90_close(nid_sta) 199 199 CALL abort_gcm(modname,'',1) 200 200 END IF … … 202 202 iret=NF90_INQ_VARID(nid_sta,'masque',nid_msk) 203 203 iret=nf90_get_var(nid_sta,nid_msk,masktmp) 204 iret= NF90_CLOSE(nid_sta)204 iret=nf90_close(nid_sta) 205 205 CALL gr_fi_dyn(1,klon,iip1,jjp1,masktmp,masque) 206 206 IF(prt_level>=1) THEN -
LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/limit_netcdf.f90
r5099 r5100 1 1 MODULE limit 2 2 3 !******************************************************************************* 4 ! Author : L. Fairhead, 27/01/94 5 !------------------------------------------------------------------------------- 6 ! Purpose: Boundary conditions files building for new model using climatologies. 7 ! Both grids have to be regular. 8 !------------------------------------------------------------------------------- 9 ! Note: This routine is designed to work for Earth 10 !------------------------------------------------------------------------------- 11 ! Modification history: 12 ! * 23/03/1994: Z. X. Li 13 ! * 09/1999: L. Fairhead (netcdf reading in LMDZ.3.3) 14 ! * 07/2001: P. Le Van 15 ! * 11/2009: L. Guez (ozone day & night climatos, see etat0_netcdf.F90) 16 ! * 12/2009: D. Cugnet (f77->f90, calendars, files from coupled runs) 17 !------------------------------------------------------------------------------- 18 19 USE ioipsl, ONLY : flininfo, flinopen, flinget, flinclo 20 USE assert_eq_m, ONLY : assert_eq 21 USE cal_tools_m, ONLY : year_len, mid_month 22 USE conf_dat_m, ONLY : conf_dat2d, conf_dat3d 23 USE dimphy, ONLY : klon, zmasq 24 USE geometry_mod, ONLY : longitude_deg, latitude_deg 25 USE phys_state_var_mod, ONLY : pctsrf 26 USE control_mod, ONLY : anneeref 27 USE init_ssrf_m, ONLY : start_init_subsurf 28 29 INTEGER, PARAMETER :: ns = 256 30 CHARACTER(LEN = ns), PARAMETER :: & 31 fsst(5) = ['amipbc_sst_1x1.nc ', 'amip_sst_1x1.nc ', 'cpl_atm_sst.nc '& 32 , 'histmth_sst.nc ', 'sstk.nc '], & 33 fsic(5) = ['amipbc_sic_1x1.nc ', 'amip_sic_1x1.nc ', 'cpl_atm_sic.nc '& 34 , 'histmth_sic.nc ', 'ci.nc '], & 35 vsst(5) = ['tosbcs ', 'tos ', 'SISUTESW ', 'tsol_oce ', 'sstk '], & 36 vsic(5) = ['sicbcs ', 'sic ', 'SIICECOV ', 'pourc_sic ', 'ci '], & 37 frugo = 'Rugos.nc ', falbe = 'Albedo.nc ', frelf = 'Relief.nc ', & 38 vrug = 'RUGOS ', valb = 'ALBEDO ', vrel = 'RELIEF ', & 39 DegK(11) = ['degK ', 'degree_K ', 'degreeK ', 'deg_K '& 40 , 'degsK ', 'degrees_K ', 'degreesK ', 'degs_K '& 41 , 'degree_kelvin ', 'degrees_kelvin', 'K '], & 42 DegC(10) = ['degC ', 'degree_C ', 'degreeC ', 'deg_C '& 43 , 'degsC ', 'degrees_C ', 'degreesC ', 'degs_C '& 44 , 'degree_Celsius', 'celsius '], & 45 Perc(2) = ['% ', 'percent '], & 46 Frac(2) = ['1.0 ', '1 '] 47 48 CONTAINS 49 50 !------------------------------------------------------------------------------- 51 52 SUBROUTINE limit_netcdf(masque, phis, extrap) 53 54 !------------------------------------------------------------------------------- 55 ! Author : L. Fairhead, 27/01/94 56 !------------------------------------------------------------------------------- 57 ! Purpose: Boundary conditions files building for new model using climatologies. 58 ! Both grids have to be regular. 59 !------------------------------------------------------------------------------- 60 ! Note: This routine is designed to work for Earth 61 !------------------------------------------------------------------------------- 62 ! Modification history: 63 ! * 23/03/1994: Z. X. Li 64 ! * 09/1999: L. Fairhead (netcdf reading in LMDZ.3.3) 65 ! * 07/2001: P. Le Van 66 ! * 11/2009: L. Guez (ozone day & night climatos, see etat0_netcdf.F90) 67 ! * 12/2009: D. Cugnet (f77->f90, calendars, files from coupled runs) 68 ! * 04/2016: D. Cugnet (12/14 recs SST/SIC files: cyclic/interannual runs) 69 ! * 05/2017: D. Cugnet (linear time interpolation for BCS files) 70 !------------------------------------------------------------------------------- 71 USE indice_sol_mod 72 USE netcdf, ONLY : nf90_open, nf90_create, nf90_close, & 73 nf90_def_dim, nf90_def_var, nf90_put_var, nf90_put_att, & 74 nf90_noerr, nf90_nowrite, nf90_global, & 75 nf90_clobber, nf90_enddef, nf90_unlimited, nf90_float, & 76 nf90_64bit_offset 77 USE lmdz_cppkeys_wrapper, ONLY : nf90_format 78 USE inter_barxy_m, ONLY : inter_barxy 79 USE netcdf95, ONLY : nf95_def_var, nf95_put_att, nf95_put_var 80 USE comconst_mod, ONLY : pi 81 USE phys_cal_mod, ONLY : calend 82 IMPLICIT NONE 83 !------------------------------------------------------------------------------- 84 ! Arguments: 85 include "iniprint.h" 86 include "dimensions.h" 87 include "paramet.h" 88 REAL, DIMENSION(iip1, jjp1), INTENT(INOUT) :: masque ! land mask 89 REAL, DIMENSION(iip1, jjp1), INTENT(INOUT) :: phis ! ground geopotential 90 LOGICAL, INTENT(IN) :: extrap ! SST extrapolation flag 91 !------------------------------------------------------------------------------- 92 ! Local variables: 93 include "comgeom2.h" 94 95 !--- INPUT NETCDF FILES AND VARIABLES NAMES ------------------------------------ 96 CHARACTER(LEN = ns) :: icefile, sstfile, fnam, varname 97 98 !--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------ 99 REAL :: fi_ice(klon) 100 REAL, POINTER :: phy_rug(:, :) => NULL(), phy_ice(:, :) => NULL() 101 REAL, POINTER :: phy_sst(:, :) => NULL(), phy_alb(:, :) => NULL() 102 REAL, ALLOCATABLE :: phy_bil(:, :), pctsrf_t(:, :, :) 103 INTEGER :: nbad 104 105 !--- VARIABLES FOR OUTPUT FILE WRITING ----------------------------------------- 106 INTEGER :: nid, ndim, ntim, k, dims(2), ix_sic, ix_sst 107 INTEGER :: id_tim, id_SST, id_BILS, id_RUG, id_ALB 108 INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC, varid_longitude, varid_latitude 109 INTEGER :: ndays !--- Depending on the output calendar 110 CHARACTER(LEN = ns) :: str 111 112 !--- INITIALIZATIONS ----------------------------------------------------------- 113 CALL inigeom 114 115 !--- MASK, GROUND GEOPOT. & SUBSURFACES COMPUTATION (IN CASE ok_etat0==.FALSE.) 116 IF(ALL(masque==-99999.)) THEN 117 CALL start_init_orog0(rlonv, rlatu, phis, masque) 118 CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, zmasq) !--- To physical grid 119 ALLOCATE(pctsrf(klon, nbsrf)) 120 CALL start_init_subsurf(.FALSE.) 121 !--- TO MATCH EXACTLY WHAT WOULD BE DONE IN etat0phys_netcdf 122 WHERE(masque(:, :)<EPSFRA) masque(:, :) = 0. 123 WHERE(1. - masque(:, :)<EPSFRA) masque(:, :) = 1. 124 END IF 125 126 !--- Beware: anneeref (from gcm.def) is used to determine output time sampling 127 ndays = year_len(anneeref) 128 129 !--- RUGOSITY TREATMENT -------------------------------------------------------- 130 CALL msg(0, ""); CALL msg(0, " *** TRAITEMENT DE LA RUGOSITE ***") 131 CALL get_2Dfield(frugo, vrug, 'RUG', ndays, phy_rug, mask = masque(1:iim, :)) 132 133 !--- OCEAN TREATMENT ----------------------------------------------------------- 134 CALL msg(0, ""); CALL msg(0, " *** TRAITEMENT DE LA GLACE OCEANIQUE ***") 135 136 ! Input SIC file selection 137 ! Open file only to test if available 138 DO ix_sic = 1, SIZE(fsic) 139 IF (nf90_open(TRIM(fsic(ix_sic)), nf90_nowrite, nid)==nf90_noerr) THEN 140 icefile = fsic(ix_sic); varname = vsic(ix_sic); EXIT 141 END IF 142 END DO 143 IF(ix_sic==SIZE(fsic) + 1) THEN 144 WRITE(lunout, *) 'ERROR! No sea-ice input file was found.' 145 WRITE(lunout, *) 'One of following files must be available : ' 146 DO k = 1, SIZE(fsic); WRITE(lunout, *) TRIM(fsic(k)); 147 END DO 148 CALL abort_physic('limit_netcdf', 'No sea-ice file was found', 1) 149 END IF 150 CALL ncerr(nf90_close(nid), icefile) 151 CALL msg(0, 'Fichier choisi pour la glace de mer:' // TRIM(icefile)) 152 153 CALL get_2Dfield(icefile, varname, 'SIC', ndays, phy_ice) 154 155 ALLOCATE(pctsrf_t(klon, nbsrf, ndays)) 156 DO k = 1, ndays 157 fi_ice = phy_ice(:, k) 158 WHERE(fi_ice>=1.0) fi_ice = 1.0 159 WHERE(fi_ice<EPSFRA) fi_ice = 0.0 160 pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter) ! land soil 161 pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic) ! land ice 162 SELECT CASE(ix_sic) 163 CASE(3) ! SIC=pICE*(1-LIC-TER) (CPL) 164 pctsrf_t(:, is_sic, k) = fi_ice(:) * (1. - pctsrf(:, is_lic) - pctsrf(:, is_ter)) 165 CASE(4) ! SIC=pICE (HIST) 166 pctsrf_t(:, is_sic, k) = fi_ice(:) 167 CASE DEFAULT ! SIC=pICE-LIC (AMIP,ERAI) 168 pctsrf_t(:, is_sic, k) = fi_ice - pctsrf_t(:, is_lic, k) 169 END SELECT 170 WHERE(pctsrf_t(:, is_sic, k)<=0) pctsrf_t(:, is_sic, k) = 0. 171 WHERE(1.0 - zmasq<EPSFRA) 172 pctsrf_t(:, is_sic, k) = 0.0 173 pctsrf_t(:, is_oce, k) = 0.0 174 ELSEWHERE 175 WHERE(pctsrf_t(:, is_sic, k)>=1.0 - zmasq) 176 pctsrf_t(:, is_sic, k) = 1.0 - zmasq 177 pctsrf_t(:, is_oce, k) = 0.0 178 ELSEWHERE 179 pctsrf_t(:, is_oce, k) = 1.0 - zmasq - pctsrf_t(:, is_sic, k) 180 WHERE(pctsrf_t(:, is_oce, k)<EPSFRA) 181 pctsrf_t(:, is_oce, k) = 0.0 182 pctsrf_t(:, is_sic, k) = 1.0 - zmasq 183 END WHERE 184 END WHERE 185 END WHERE 186 nbad = COUNT(pctsrf_t(:, is_oce, k)<0.0) 187 IF(nbad>0) WRITE(lunout, *) 'pb sous maille pour nb points = ', nbad 188 nbad = COUNT(ABS(SUM(pctsrf_t(:, :, k), DIM = 2) - 1.0)>EPSFRA) 189 IF(nbad>0) WRITE(lunout, *) 'pb sous surface pour nb points = ', nbad 190 END DO 191 DEALLOCATE(phy_ice) 192 193 !--- SST TREATMENT ------------------------------------------------------------- 194 CALL msg(0, ""); CALL msg(0, " *** TRAITEMENT DE LA SST ***") 195 196 ! Input SST file selection 197 ! Open file only to test if available 198 DO ix_sst = 1, SIZE(fsst) 199 IF (nf90_open(TRIM(fsst(ix_sst)), nf90_nowrite, nid)==nf90_noerr) THEN 200 sstfile = fsst(ix_sst); varname = vsst(ix_sst); EXIT 201 END IF 202 END DO 203 IF(ix_sst==SIZE(fsst) + 1) THEN 204 WRITE(lunout, *) 'ERROR! No sst input file was found.' 205 WRITE(lunout, *) 'One of following files must be available : ' 206 DO k = 1, SIZE(fsst); WRITE(lunout, *) TRIM(fsst(k)); 207 END DO 208 CALL abort_physic('limit_netcdf', 'No sst file was found', 1) 209 END IF 210 CALL ncerr(nf90_close(nid), sstfile) 211 CALL msg(0, 'Fichier choisi pour la temperature de mer: ' // TRIM(sstfile)) 212 213 CALL get_2Dfield(sstfile, varname, 'SST', ndays, phy_sst, flag = extrap) 214 215 !--- ALBEDO TREATMENT ---------------------------------------------------------- 216 CALL msg(0, ""); CALL msg(0, " *** TRAITEMENT DE L'ALBEDO ***") 217 CALL get_2Dfield(falbe, valb, 'ALB', ndays, phy_alb) 218 219 !--- REFERENCE GROUND HEAT FLUX TREATMENT -------------------------------------- 220 ALLOCATE(phy_bil(klon, ndays)); phy_bil = 0.0 221 222 !--- OUTPUT FILE WRITING ------------------------------------------------------- 223 CALL msg(0, ""); CALL msg(0, ' *** Ecriture du fichier limit : debut ***') 224 fnam = "limit.nc" 225 226 !--- File creation 227 CALL ncerr(nf90_create(fnam, IOR(nf90_clobber, nf90_64bit_offset), nid), fnam) 228 CALL ncerr(nf90_put_att(nid, nf90_global, "title", "Fichier conditions aux limites"), fnam) 229 str = 'File produced using ce0l executable.' 230 str = TRIM(str) // NEW_LINE(' ') // 'Sea Ice Concentration built from' 231 SELECT CASE(ix_sic) 232 CASE(1); str = TRIM(str) // ' Amip mid-month boundary condition (BCS).' 233 CASE(2); str = TRIM(str) // ' Amip monthly mean observations.' 234 CASE(3); str = TRIM(str) // ' IPSL coupled model outputs.' 235 CASE(4); str = TRIM(str) // ' LMDZ model outputs.' 236 CASE(5); str = TRIM(str) // ' ci.nc file.' 237 END SELECT 238 str = TRIM(str) // NEW_LINE(' ') // 'Sea Surface Temperature built from' 239 SELECT CASE(ix_sst) 240 CASE(1); str = TRIM(str) // ' Amip mid-month boundary condition (BCS).' 241 CASE(2); str = TRIM(str) // ' Amip monthly mean observations.' 242 CASE(3); str = TRIM(str) // ' IPSL coupled model outputs.' 243 CASE(4); str = TRIM(str) // ' LMDZ model outputs.' 244 CASE(5); str = TRIM(str) // ' sstk.nc file.' 245 END SELECT 246 CALL ncerr(nf90_put_att(nid, nf90_global, "history", TRIM(str)), fnam) 247 248 !--- Dimensions creation 249 CALL ncerr(nf90_def_dim(nid, "points_physiques", klon, ndim), fnam) 250 CALL ncerr(nf90_def_dim(nid, "time", nf90_unlimited, ntim), fnam) 251 252 dims = [ndim, ntim] 253 254 !--- Variables creation 255 CALL ncerr(nf90_def_var(nid, "TEMPS", nf90_format, [ntim], id_tim), fnam) 256 CALL ncerr(nf90_def_var(nid, "FOCE", nf90_format, dims, id_FOCE), fnam) 257 CALL ncerr(nf90_def_var(nid, "FSIC", nf90_format, dims, id_FSIC), fnam) 258 CALL ncerr(nf90_def_var(nid, "FTER", nf90_format, dims, id_FTER), fnam) 259 CALL ncerr(nf90_def_var(nid, "FLIC", nf90_format, dims, id_FLIC), fnam) 260 CALL ncerr(nf90_def_var(nid, "SST", nf90_format, dims, id_SST), fnam) 261 CALL ncerr(nf90_def_var(nid, "BILS", nf90_format, dims, id_BILS), fnam) 262 CALL ncerr(nf90_def_var(nid, "ALB", nf90_format, dims, id_ALB), fnam) 263 CALL ncerr(nf90_def_var(nid, "RUG", nf90_format, dims, id_RUG), fnam) 264 call nf95_def_var(nid, "longitude", nf90_float, ndim, varid_longitude) 265 call nf95_def_var(nid, "latitude", nf90_float, ndim, varid_latitude) 266 267 !--- Attributes creation 268 CALL ncerr(nf90_put_att(nid, id_tim, "title", "Jour dans l annee"), fnam) 269 CALL ncerr(nf90_put_att(nid, id_tim, "calendar", calend), fnam) 270 CALL ncerr(nf90_put_att(nid, id_FOCE, "title", "Fraction ocean"), fnam) 271 CALL ncerr(nf90_put_att(nid, id_FSIC, "title", "Fraction glace de mer"), fnam) 272 CALL ncerr(nf90_put_att(nid, id_FTER, "title", "Fraction terre"), fnam) 273 CALL ncerr(nf90_put_att(nid, id_FLIC, "title", "Fraction land ice"), fnam) 274 CALL ncerr(nf90_put_att(nid, id_SST, "title", "Temperature superficielle de la mer"), fnam) 275 CALL ncerr(nf90_put_att(nid, id_BILS, "title", "Reference flux de chaleur au sol"), fnam) 276 CALL ncerr(nf90_put_att(nid, id_ALB, "title", "Albedo a la surface"), fnam) 277 CALL ncerr(nf90_put_att(nid, id_RUG, "title", "Rugosite"), fnam) 278 279 call nf95_put_att(nid, varid_longitude, "standard_name", "longitude") 280 call nf95_put_att(nid, varid_longitude, "units", "degrees_east") 281 282 call nf95_put_att(nid, varid_latitude, "standard_name", "latitude") 283 call nf95_put_att(nid, varid_latitude, "units", "degrees_north") 284 285 CALL ncerr(nf90_enddef(nid), fnam) 286 287 !--- Variables saving 288 CALL ncerr(nf90_put_var(nid, id_tim, [(REAL(k), k = 1, ndays)]), fnam) 289 CALL ncerr(nf90_put_var(nid, id_FOCE, pctsrf_t(:, is_oce, :), [1, 1], [klon, ndays]), fnam) 290 CALL ncerr(nf90_put_var(nid, id_FSIC, pctsrf_t(:, is_sic, :), [1, 1], [klon, ndays]), fnam) 291 CALL ncerr(nf90_put_var(nid, id_FTER, pctsrf_t(:, is_ter, :), [1, 1], [klon, ndays]), fnam) 292 CALL ncerr(nf90_put_var(nid, id_FLIC, pctsrf_t(:, is_lic, :), [1, 1], [klon, ndays]), fnam) 293 CALL ncerr(nf90_put_var(nid, id_SST, phy_sst(:, :), [1, 1], [klon, ndays]), fnam) 294 CALL ncerr(nf90_put_var(nid, id_BILS, phy_bil(:, :), [1, 1], [klon, ndays]), fnam) 295 CALL ncerr(nf90_put_var(nid, id_ALB, phy_alb(:, :), [1, 1], [klon, ndays]), fnam) 296 CALL ncerr(nf90_put_var(nid, id_RUG, phy_rug(:, :), [1, 1], [klon, ndays]), fnam) 297 call nf95_put_var(nid, varid_longitude, longitude_deg) 298 call nf95_put_var(nid, varid_latitude, latitude_deg) 299 300 CALL ncerr(nf90_close(nid), fnam) 301 302 CALL msg(0, ""); CALL msg(0, ' *** Ecriture du fichier limit : fin ***') 303 304 DEALLOCATE(pctsrf_t, phy_sst, phy_bil, phy_alb, phy_rug) 305 306 307 !=============================================================================== 308 309 CONTAINS 310 311 !=============================================================================== 312 313 314 !------------------------------------------------------------------------------- 315 316 SUBROUTINE get_2Dfield(fnam, varname, mode, ndays, champo, flag, mask) 317 318 !----------------------------------------------------------------------------- 319 ! Comments: 320 ! There are two assumptions concerning the NetCDF files, that are satisfied 321 ! with files that are conforming NC convention: 322 ! 1) The last dimension of the variables used is the time record. 323 ! 2) Dimensional variables have the same names as corresponding dimensions. 324 !----------------------------------------------------------------------------- 325 USE netcdf, ONLY : nf90_open, NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, & 326 nf90_close, nf90_inq_dimid, nf90_inquire_dimension, nf90_get_var, & 327 nf90_get_att 328 USE pchsp_95_m, only : pchsp_95 329 USE pchfe_95_m, only : pchfe_95 330 USE arth_m, only : arth 331 USE indice_sol_mod 332 333 IMPLICIT NONE 334 include "dimensions.h" 335 include "paramet.h" 336 include "comgeom2.h" 337 !----------------------------------------------------------------------------- 338 ! Arguments: 339 CHARACTER(LEN = *), INTENT(IN) :: fnam ! NetCDF file name 340 CHARACTER(LEN = *), INTENT(IN) :: varname ! NetCDF variable name 341 CHARACTER(LEN = *), INTENT(IN) :: mode ! RUG, SIC, SST or ALB 342 INTEGER, INTENT(IN) :: ndays ! current year number of days 343 REAL, POINTER, DIMENSION(:, :) :: champo ! output field = f(t) 344 LOGICAL, OPTIONAL, INTENT(IN) :: flag ! extrapol. (SST) old ice (SIC) 345 REAL, OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask 346 !------------------------------------------------------------------------------ 347 ! Local variables: 348 !--- NetCDF 349 INTEGER :: ncid, varid ! NetCDF identifiers 350 CHARACTER(LEN = ns) :: dnam ! dimension name 351 !--- dimensions 352 INTEGER :: dids(4) ! NetCDF dimensions identifiers 353 REAL, ALLOCATABLE :: dlon_ini(:) ! initial longitudes vector 354 REAL, ALLOCATABLE :: dlat_ini(:) ! initial latitudes vector 355 REAL, POINTER :: dlon(:), dlat(:) ! reordered lon/lat vectors 356 !--- fields 357 INTEGER :: imdep, jmdep, lmdep ! dimensions of 'champ' 358 REAL, ALLOCATABLE :: champ(:, :) ! wanted field on initial grid 359 REAL, ALLOCATABLE :: yder(:), timeyear(:) 360 REAL :: champint(iim, jjp1) ! interpolated field 361 REAL, ALLOCATABLE :: champtime(:, :, :) 362 REAL, ALLOCATABLE :: champan(:, :, :) 363 !--- input files 364 CHARACTER(LEN = ns) :: fnam_m, fnam_p ! previous/next files names 365 CHARACTER(LEN = ns) :: cal_in ! calendar 366 CHARACTER(LEN = ns) :: units ! attribute "units" in sic/sst file 367 INTEGER :: ndays_in ! number of days 368 REAL :: value ! mean/max value near equator 369 !--- misc 370 INTEGER :: i, j, k, l ! loop counters 371 REAL, ALLOCATABLE :: work(:, :) ! used for extrapolation 372 CHARACTER(LEN = ns) :: title, mess ! for messages 373 LOGICAL :: is_bcs ! flag for BCS data 374 LOGICAL :: extrp ! flag for extrapolation 375 LOGICAL :: ll 376 REAL :: chmin, chmax, timeday, al 377 INTEGER ierr, idx 378 integer n_extrap ! number of extrapolated points 379 logical skip 380 381 !------------------------------------------------------------------------------ 382 !---Variables depending on keyword 'mode' ------------------------------------- 383 NULLIFY(champo) 384 385 SELECT CASE(mode) 386 CASE('RUG'); title = 'Rugosite' 387 CASE('SIC'); title = 'Sea-ice' 388 CASE('SST'); title = 'SST' 389 CASE('ALB'); title = 'Albedo' 390 END SELECT 391 extrp = .FALSE.; IF(PRESENT(flag).AND.mode=='SST') extrp = flag 392 is_bcs = (mode=='SIC'.AND.ix_sic==1).OR.(mode=='SST'.AND.ix_sst==1) 393 idx = INDEX(fnam, '.nc') - 1 394 395 !--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE ----------------------------- 396 CALL msg(5, ' Now reading file : ' // TRIM(fnam)) 397 CALL ncerr(nf90_open(fnam, nf90_nowrite, ncid), fnam) 398 CALL ncerr(NF90_INQ_VARID(ncid, trim(varname), varid), fnam) 399 CALL ncerr(NF90_INQUIRE_VARIABLE(ncid, varid, dimids = dids), fnam) 400 401 !--- Longitude 402 CALL ncerr(nf90_inquire_dimension(ncid, dids(1), name = dnam, len = imdep), fnam) 403 ALLOCATE(dlon_ini(imdep), dlon(imdep)) 404 CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam) 405 CALL ncerr(nf90_get_var(ncid, varid, dlon_ini), fnam) 406 CALL msg(5, 'variable ' // TRIM(dnam) // ' dimension ', imdep) 407 408 !--- Latitude 409 CALL ncerr(nf90_inquire_dimension(ncid, dids(2), name = dnam, len = jmdep), fnam) 410 ALLOCATE(dlat_ini(jmdep), dlat(jmdep)) 411 CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam) 412 CALL ncerr(nf90_get_var(ncid, varid, dlat_ini), fnam) 413 CALL msg(5, 'variable ' // TRIM(dnam) // ' dimension ', jmdep) 414 415 !--- Time (variable is not needed - it is rebuilt - but calendar is) 416 CALL ncerr(nf90_inquire_dimension(ncid, dids(3), name = dnam, len = lmdep), fnam) 417 ALLOCATE(timeyear(lmdep + 2)) 418 CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam) 419 cal_in = ' ' 420 IF(nf90_get_att(ncid, varid, 'calendar', cal_in)/=nf90_noerr) THEN 421 SELECT CASE(mode) 422 CASE('RUG', 'ALB'); cal_in = '360_day' 423 CASE('SIC', 'SST'); cal_in = 'gregorian' 424 END SELECT 425 CALL msg(0, 'WARNING: missing "calendar" attribute for "time" in '& 426 // TRIM(fnam) // '. Choosing default value.') 427 END IF 428 CALL strclean(cal_in) !--- REMOVE (WEIRD) NULL CHARACTERS 429 CALL msg(0, 'var, calendar, dim: ' // TRIM(dnam) // ' ' // TRIM(cal_in), lmdep) 430 431 !--- Determining input file number of days, depending on calendar 432 ndays_in = year_len(anneeref, cal_in) 433 434 !--- Rebuilding input time vector (field from input file might be unreliable) 435 IF(lmdep==12) THEN 436 timeyear = mid_month(anneeref, cal_in) 437 CALL msg(0, 'Monthly input file(s) for ' // TRIM(title) // '.') 438 ELSE IF(lmdep==ndays_in) THEN 439 timeyear = [(REAL(k) - 0.5, k = 0, ndays_in + 1)] 440 CALL msg(0, 'Daily input file (no time interpolation).') 441 ELSE 442 WRITE(mess, '(a,i3,a,i3,a)')'Mismatching input file: found', lmdep, & 443 ' records, 12/', ndays_in, ' (monthly/daily needed).' 444 CALL abort_physic('mid_month', TRIM(mess), 1) 445 END IF 446 447 !--- GETTING THE FIELD AND INTERPOLATING IT ---------------------------------- 448 ALLOCATE(champ(imdep, jmdep), champtime(iim, jjp1, lmdep + 2)) 449 IF(extrp) ALLOCATE(work(imdep, jmdep)) 450 CALL msg(5, '') 451 CALL msg(5, 'READ AND INTERPOLATE HORIZONTALLY ', lmdep, ' FIELDS.') 452 CALL ncerr(NF90_INQ_VARID(ncid, varname, varid), fnam) 453 DO l = 1, lmdep 454 CALL ncerr(nf90_get_var(ncid, varid, champ, [1, 1, l], [imdep, jmdep, 1]), fnam) 455 CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.) 456 457 !--- FOR SIC/SST FIELDS ONLY 458 IF(l==1.AND.is_in(mode, ['SIC', 'SST'])) THEN 459 460 !--- DETERMINE THE UNIT: READ FROM FILE OR ASSUMED USING FIELD VALUES 461 ierr = nf90_get_att(ncid, varid, 'units', units) 462 IF(ierr==nf90_noerr) THEN !--- ATTRIBUTE "units" FOUND IN THE FILE 463 CALL strclean(units) 464 IF(mode=='SIC'.AND.is_in(units, Perc)) units = "%" 465 IF(mode=='SIC'.AND.is_in(units, Frac)) units = "1" 466 IF(mode=='SST'.AND.is_in(units, DegC)) units = "C" 467 IF(mode=='SST'.AND.is_in(units, DegK)) units = "K" 468 ELSE !--- CHECK THE FIELD VALUES 469 IF(mode=='SIC') value = MAXVAL(champ(:, :)) 470 IF(mode=='SST') value = SUM(champ(:, jmdep / 2), DIM = 1) / REAL(imdep) 471 IF(mode=='SIC') THEN; units = "1"; IF(value>= 10.) units = "%"; 472 END IF 473 IF(mode=='SST') THEN; units = "C"; IF(value>=100.) units = "K"; 474 END IF 475 END IF 476 CALL msg(0, 'INPUT FILE ' // TRIM(title) // ' UNIT IS: "' // TRIM(units) // '".') 477 IF(ierr/=nf90_noerr) CALL msg(0, 'WARNING ! UNIT TO BE CHECKED ! ' & 478 // 'No "units" attribute, so only based on the fields values.') 479 480 !--- CHECK VALUES ARE IN THE EXPECTED RANGE 481 SELECT CASE(units) 482 CASE('%'); ll = ANY(champ>100.0 + EPSFRA); str = 'percentages > 100.' 483 CASE('1'); ll = ANY(champ> 1.0 + EPSFRA); str = 'fractions > 1.' 484 CASE('C'); ll = ANY(champ<-100.).OR.ANY(champ> 60.); str = '<-100 or >60 DegC' 485 CASE('K'); ll = ANY(champ< 180.).OR.ANY(champ>330.); str = '<180 or >330 DegK' 486 CASE DEFAULT; CALL abort_physic(mode, 'Unrecognized ' // TRIM(title) & 487 // ' unit: ' // TRIM(units), 1) 488 END SELECT 489 490 !--- DROPPED FOR BCS DATA (FRACTIONS CAN BE HIGHER THAN 1) 491 IF(ll.AND.ix_sic/=1.AND.mode=='SIC') & 492 CALL abort_physic(mode, 'unrealistic ' // TRIM(mode) // ' found: ' // TRIM(str), 1) 493 494 END IF 495 496 IF(extrp) CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work) 497 IF(l==1) THEN 498 CALL msg(5, "--------------------------------------------------------") 499 CALL msg(5, "$$$ Barycentric interpolation for " // TRIM(title) // " $$$") 500 CALL msg(5, "--------------------------------------------------------") 501 END IF 502 IF(mode=='RUG') champ = LOG(champ) 503 CALL inter_barxy(dlon, dlat(:jmdep - 1), champ, rlonu(:iim), rlatv, champint) 504 IF(mode=='RUG') THEN 505 champint = EXP(champint) 506 WHERE(NINT(mask)/=1) champint = 0.001 507 END IF 508 champtime(:, :, l + 1) = champint 509 END DO 510 CALL ncerr(nf90_close(ncid), fnam) 511 512 !--- FIRST RECORD: LAST ONE OF PREVIOUS YEAR (CURRENT YEAR IF UNAVAILABLE) 513 fnam_m = fnam(1:idx) // '_m.nc' 514 IF(nf90_open(fnam_m, nf90_nowrite, ncid)==nf90_noerr) THEN 515 CALL msg(0, 'Reading previous year file ("' // TRIM(fnam_m) // '") last record for ' // TRIM(title)) 516 CALL ncerr(NF90_INQ_VARID(ncid, varname, varid), fnam_m) 517 CALL ncerr(NF90_INQUIRE_VARIABLE(ncid, varid, dimids = dids), fnam_m) 518 CALL ncerr(nf90_inquire_dimension(ncid, dids(3), len = l), fnam_m) 519 CALL ncerr(nf90_get_var(ncid, varid, champ, [1, 1, l], [imdep, jmdep, 1]), fnam_m) 520 CALL ncerr(nf90_close(ncid), fnam_m) 521 CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.) 522 IF(extrp) CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work) 523 IF(mode=='RUG') champ = LOG(champ) 524 CALL inter_barxy(dlon, dlat(:jmdep - 1), champ, rlonu(:iim), rlatv, champint) 525 IF(mode=='RUG') THEN 526 champint = EXP(champint) 527 WHERE(NINT(mask)/=1) champint = 0.001 528 END IF 529 champtime(:, :, 1) = champint 530 ELSE 531 CALL msg(0, 'Using current year file ("' // TRIM(fnam) // '") last record for ' // TRIM(title)) 532 champtime(:, :, 1) = champtime(:, :, lmdep + 1) 533 END IF 534 535 !--- LAST RECORD: FIRST ONE OF NEXT YEAR (CURRENT YEAR IF UNAVAILABLE) 536 fnam_p = fnam(1:idx) // '_p.nc' 537 IF(nf90_open(fnam_p, nf90_nowrite, ncid)==nf90_noerr) THEN 538 CALL msg(0, 'Reading next year file ("' // TRIM(fnam_p) // '") first record for ' // TRIM(title)) 539 CALL ncerr(NF90_INQ_VARID(ncid, varname, varid), fnam_p) 540 CALL ncerr(nf90_get_var(ncid, varid, champ, [1, 1, 1], [imdep, jmdep, 1]), fnam_p) 541 CALL ncerr(nf90_close(ncid), fnam_p) 542 CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.) 543 IF(extrp) CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, work) 544 IF(mode=='RUG') champ = LOG(champ) 545 CALL inter_barxy(dlon, dlat(:jmdep - 1), champ, rlonu(:iim), rlatv, champint) 546 IF(mode=='RUG') THEN 547 champint = EXP(champint) 548 WHERE(NINT(mask)/=1) champint = 0.001 549 END IF 550 champtime(:, :, lmdep + 2) = champint 551 ELSE 552 CALL msg(0, 'Using current year file ("' // TRIM(fnam) // '") first record for ' // TRIM(title)) 553 champtime(:, :, lmdep + 2) = champtime(:, :, 2) 554 END IF 555 DEALLOCATE(dlon_ini, dlat_ini, dlon, dlat, champ) 556 IF(extrp) DEALLOCATE(work) 557 558 !--- TIME INTERPOLATION ------------------------------------------------------ 559 IF(prt_level>0) THEN 560 IF(ndays/=ndays_in) THEN 561 WRITE(lunout, *)'DIFFERENT YEAR LENGTHS:' 562 WRITE(lunout, *)' In the input file: ', ndays_in 563 WRITE(lunout, *)' In the output file: ', ndays 564 END IF 565 IF(lmdep==ndays_in) THEN 566 WRITE(lunout, *)'NO TIME INTERPOLATION.' 567 WRITE(lunout, *)' Daily input file.' 568 ELSE 569 IF(is_bcs) WRITE(lunout, *)'LINEAR TIME INTERPOLATION.' 570 IF(.NOT.is_bcs) WRITE(lunout, *)'SPLINES TIME INTERPOLATION.' 571 WRITE(lunout, *)' Input time vector: ', timeyear 572 WRITE(lunout, *)' Output time vector: from 0.5 to ', ndays - 0.5 573 END IF 574 END IF 575 ALLOCATE(champan(iip1, jjp1, ndays)) 576 577 IF(lmdep==ndays_in) THEN !--- DAILY DATA: NO TIME INTERPOLATION 578 DO l = 1, lmdep 579 champan(1:iim, :, l) = champtime(:, :, l + 1) 580 END DO 581 ELSE IF(is_bcs) THEN !--- BCS DATA: LINEAR TIME INTERPOLATION 582 l = 1 583 DO k = 1, ndays 584 timeday = (REAL(k) - 0.5) * REAL(ndays_in) / ndays 585 IF(timeyear(l + 1)<timeday) l = l + 1 586 al = (timeday - timeyear(l)) / (timeyear(l + 1) - timeyear(l)) 587 champan(1:iim, :, k) = champtime(1:iim, :, l) + al * (champtime(1:iim, :, l + 1) - champtime(1:iim, :, l)) 588 END DO 589 ELSE !--- AVE DATA: SPLINE TIME INTERPOLATION 590 skip = .false. 591 n_extrap = 0 592 ALLOCATE(yder(lmdep + 2)) 593 DO j = 1, jjp1 594 DO i = 1, iim 595 yder = pchsp_95(timeyear, champtime(i, j, :), ibeg = 2, iend = 2, & 596 vc_beg = 0., vc_end = 0.) 597 CALL pchfe_95(timeyear, champtime(i, j, :), yder, skip, & 598 arth(0.5, real(ndays_in) / ndays, ndays), champan(i, j, :), ierr) 599 if (ierr < 0) call abort_physic("get_2Dfield", "", 1) 600 n_extrap = n_extrap + ierr 601 END DO 602 END DO 603 IF(n_extrap /= 0) WRITE(lunout, *) "get_2Dfield pchfe_95: n_extrap = ", n_extrap 604 DEALLOCATE(yder) 605 END IF 606 champan(iip1, :, :) = champan(1, :, :) 607 DEALLOCATE(champtime, timeyear) 608 609 !--- Checking the result 610 DO j = 1, jjp1 611 CALL minmax(iip1, champan(1, j, 10), chmin, chmax) 612 IF (prt_level>5) WRITE(lunout, *)' ', TRIM(title), ' at time 10 ', chmin, chmax, j 613 END DO 614 615 !--- SPECIAL FILTER FOR SST: SST>271.38 -------------------------------------- 616 IF(mode=='SST') THEN 617 SELECT CASE(units) 618 CASE("K"); CALL msg(0, 'SST field is already in kelvins.') 619 CASE("C"); CALL msg(0, 'SST field converted from celcius degrees to kelvins.') 620 champan(:, :, :) = champan(:, :, :) + 273.15 621 END SELECT 622 CALL msg(0, 'Filtering SST: Sea Surface Temperature >= 271.38') 623 WHERE(champan<271.38) champan = 271.38 624 END IF 625 626 !--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 ------------------------------------- 627 IF(mode=='SIC') THEN 628 SELECT CASE(units) 629 CASE("1"); CALL msg(0, 'SIC field already in fraction of 1') 630 CASE("%"); CALL msg(0, 'SIC field converted from percentage to fraction of 1.') 631 champan(:, :, :) = champan(:, :, :) / 100. 632 END SELECT 633 CALL msg(0, 'Filtering SIC: 0.0 <= Sea-ice <=1.0') 634 WHERE(champan>1.0) champan = 1.0 635 WHERE(champan<0.0) champan = 0.0 636 END IF 637 638 !--- DYNAMICAL TO PHYSICAL GRID ---------------------------------------------- 639 ALLOCATE(champo(klon, ndays)) 640 DO k = 1, ndays 641 CALL gr_dyn_fi(1, iip1, jjp1, klon, champan(1, 1, k), champo(:, k)) 642 END DO 643 DEALLOCATE(champan) 644 645 END SUBROUTINE get_2Dfield 646 647 !------------------------------------------------------------------------------- 648 649 650 !------------------------------------------------------------------------------- 651 652 SUBROUTINE start_init_orog0(lon_in, lat_in, phis, masque) 653 654 !------------------------------------------------------------------------------- 655 USE grid_noro_m, ONLY : grid_noro0 656 IMPLICIT NONE 657 !=============================================================================== 658 ! Purpose: Compute "phis" just like it would be in start_init_orog. 659 !=============================================================================== 660 ! Arguments: 661 REAL, INTENT(IN) :: lon_in(:), lat_in(:) ! dim (iml) (jml) 662 REAL, INTENT(INOUT) :: phis(:, :), masque(:, :) ! dim (iml,jml) 663 !------------------------------------------------------------------------------- 664 ! Local variables: 665 CHARACTER(LEN = ns) :: modname = "start_init_orog0" 666 INTEGER :: fid, llm_tmp, ttm_tmp, iml, jml, iml_rel, jml_rel, itau(1) 667 REAL :: lev(1), date, dt, deg2rad 668 REAL, ALLOCATABLE :: lon_rad(:), lon_ini(:), lon_rel(:, :), relief_hi(:, :) 669 REAL, ALLOCATABLE :: lat_rad(:), lat_ini(:), lat_rel(:, :) 670 !------------------------------------------------------------------------------- 671 iml = assert_eq(SIZE(lon_in), SIZE(phis, 1), SIZE(masque, 1), TRIM(modname) // " iml") 672 jml = assert_eq(SIZE(lat_in), SIZE(phis, 2), SIZE(masque, 2), TRIM(modname) // " jml") 673 IF(iml/=iip1) CALL abort_gcm(TRIM(modname), 'iml/=iip1', 1) 674 IF(jml/=jjp1) CALL abort_gcm(TRIM(modname), 'jml/=jjp1', 1) 675 pi = 2.0 * ASIN(1.0); deg2rad = pi / 180.0 676 IF(ANY(phis/=-99999.)) RETURN !--- phis ALREADY KNOWN 677 678 !--- HIGH RESOLUTION OROGRAPHY 679 CALL flininfo(frelf, iml_rel, jml_rel, llm_tmp, ttm_tmp, fid) 680 681 ALLOCATE(lat_rel(iml_rel, jml_rel), lon_rel(iml_rel, jml_rel)) 682 CALL flinopen(frelf, .FALSE., iml_rel, jml_rel, llm_tmp, lon_rel, lat_rel, & 683 lev, ttm_tmp, itau, date, dt, fid) 684 ALLOCATE(relief_hi(iml_rel, jml_rel)) 685 CALL flinget(fid, vrel, iml_rel, jml_rel, llm_tmp, ttm_tmp, 1, 1, relief_hi) 686 CALL flinclo(fid) 687 688 !--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS 689 ALLOCATE(lon_ini(iml_rel), lat_ini(jml_rel)) 690 lon_ini(:) = lon_rel(:, 1); IF(MAXVAL(lon_rel)>pi) lon_ini = lon_ini * deg2rad 691 lat_ini(:) = lat_rel(1, :); IF(MAXVAL(lat_rel)>pi) lat_ini = lat_ini * deg2rad 692 693 !--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS 694 ALLOCATE(lon_rad(iml_rel), lat_rad(jml_rel)) 695 CALL conf_dat2d(vrel, lon_ini, lat_ini, lon_rad, lat_rad, relief_hi, .FALSE.) 696 DEALLOCATE(lon_ini, lat_ini) 697 698 !--- COMPUTING SURFACE GEOPOTENTIAL USING ROUTINE grid_noro0 699 WRITE(lunout, *) 700 WRITE(lunout, *)'*** Compute surface geopotential ***' 701 702 !--- CALL OROGRAPHY MODULE (REDUCED VERSION) TO COMPUTE FIELDS 703 CALL grid_noro0(lon_rad, lat_rad, relief_hi, lon_in, lat_in, phis, masque) 704 phis = phis * 9.81 705 phis(iml, :) = phis(1, :) 706 DEALLOCATE(relief_hi, lon_rad, lat_rad) 707 708 END SUBROUTINE start_init_orog0 709 710 !------------------------------------------------------------------------------- 711 712 713 !------------------------------------------------------------------------------- 714 715 SUBROUTINE msg(lev, str1, i, str2) 716 717 !------------------------------------------------------------------------------- 718 ! Arguments: 719 INTEGER, INTENT(IN) :: lev 720 CHARACTER(LEN = *), INTENT(IN) :: str1 721 INTEGER, OPTIONAL, INTENT(IN) :: i 722 CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: str2 723 !------------------------------------------------------------------------------- 724 IF(prt_level>=lev) THEN 725 IF(PRESENT(str2)) THEN 726 WRITE(lunout, *) TRIM(str1), i, TRIM(str2) 727 ELSE IF(PRESENT(i)) THEN 728 WRITE(lunout, *) TRIM(str1), i 729 ELSE 730 WRITE(lunout, *) TRIM(str1) 731 END IF 732 END IF 733 734 END SUBROUTINE msg 735 736 !------------------------------------------------------------------------------- 737 738 739 !------------------------------------------------------------------------------- 740 741 SUBROUTINE ncerr(ncres, fnam) 742 743 !------------------------------------------------------------------------------- 744 ! Purpose: NetCDF errors handling. 745 !------------------------------------------------------------------------------- 746 USE netcdf, ONLY : nf90_noerr, NF90_STRERROR 747 IMPLICIT NONE 748 !------------------------------------------------------------------------------- 749 ! Arguments: 750 INTEGER, INTENT(IN) :: ncres 751 CHARACTER(LEN = *), INTENT(IN) :: fnam 752 !------------------------------------------------------------------------------- 753 IF(ncres/=nf90_noerr) THEN 754 WRITE(lunout, *)'Problem with file ' // TRIM(fnam) // ' in routine limit_netcdf.' 755 CALL abort_physic('limit_netcdf', NF90_STRERROR(ncres), 1) 756 END IF 757 758 END SUBROUTINE ncerr 759 760 !------------------------------------------------------------------------------- 761 762 763 !------------------------------------------------------------------------------- 764 765 SUBROUTINE strclean(s) 766 767 !------------------------------------------------------------------------------- 768 IMPLICIT NONE 769 !------------------------------------------------------------------------------- 770 ! Purpose: Remove tail null characters from the input string. 771 !------------------------------------------------------------------------------- 772 ! Parameters: 773 CHARACTER(LEN = *), INTENT(INOUT) :: s 774 !------------------------------------------------------------------------------- 775 ! Local variable: 776 INTEGER :: k 777 !------------------------------------------------------------------------------- 778 k = LEN_TRIM(s); DO WHILE(ICHAR(s(k:k))==0); s(k:k) = ' '; k = LEN_TRIM(s); 779 END DO 780 781 END SUBROUTINE strclean 782 783 !------------------------------------------------------------------------------- 784 785 786 !------------------------------------------------------------------------------- 787 788 FUNCTION is_in(s1, s2) RESULT(res) 789 790 !------------------------------------------------------------------------------- 791 IMPLICIT NONE 792 !------------------------------------------------------------------------------- 793 ! Purpose: Check wether s1 is present in the s2(:) list (case insensitive). 794 !------------------------------------------------------------------------------- 795 ! Arguments: 796 CHARACTER(LEN = *), INTENT(IN) :: s1, s2(:) 797 LOGICAL :: res 798 !------------------------------------------------------------------------------- 799 res = .FALSE.; DO k = 1, SIZE(s2); res = res.OR.strLow(s1)==strLow(s2(k)); 800 END DO 801 802 END FUNCTION is_in 803 804 !------------------------------------------------------------------------------- 805 806 807 !------------------------------------------------------------------------------- 808 809 ELEMENTAL FUNCTION strLow(s) RESULT(res) 810 811 !------------------------------------------------------------------------------- 812 IMPLICIT NONE 813 !------------------------------------------------------------------------------- 814 ! Purpose: Lower case conversion. 815 !------------------------------------------------------------------------------- 816 ! Arguments: 817 CHARACTER(LEN = *), INTENT(IN) :: s 818 CHARACTER(LEN = ns) :: res 819 !------------------------------------------------------------------------------- 820 ! Local variable: 821 INTEGER :: k, ix 822 !------------------------------------------------------------------------------- 823 res = s 824 DO k = 1, LEN(s); ix = IACHAR(s(k:k)) 825 IF(64<ix.AND.ix<91) res(k:k) = ACHAR(ix + 32) 826 END DO 827 828 END FUNCTION strLow 829 830 !------------------------------------------------------------------------------- 831 832 END SUBROUTINE limit_netcdf 833 834 END MODULE limit 835 3 836 !******************************************************************************* 4 ! Author : L. Fairhead, 27/01/94 5 !------------------------------------------------------------------------------- 6 ! Purpose: Boundary conditions files building for new model using climatologies. 7 ! Both grids have to be regular. 8 !------------------------------------------------------------------------------- 9 ! Note: This routine is designed to work for Earth 10 !------------------------------------------------------------------------------- 11 ! Modification history: 12 ! * 23/03/1994: Z. X. Li 13 ! * 09/1999: L. Fairhead (netcdf reading in LMDZ.3.3) 14 ! * 07/2001: P. Le Van 15 ! * 11/2009: L. Guez (ozone day & night climatos, see etat0_netcdf.F90) 16 ! * 12/2009: D. Cugnet (f77->f90, calendars, files from coupled runs) 17 !------------------------------------------------------------------------------- 18 19 USE ioipsl, ONLY: flininfo, flinopen, flinget, flinclo 20 USE assert_eq_m, ONLY: assert_eq 21 USE cal_tools_m, ONLY: year_len, mid_month 22 USE conf_dat_m, ONLY: conf_dat2d, conf_dat3d 23 USE dimphy, ONLY: klon, zmasq 24 USE geometry_mod, ONLY: longitude_deg, latitude_deg 25 USE phys_state_var_mod, ONLY: pctsrf 26 USE control_mod, ONLY: anneeref 27 USE init_ssrf_m, ONLY: start_init_subsurf 28 29 INTEGER, PARAMETER :: ns=256 30 CHARACTER(LEN=ns), PARAMETER :: & 31 fsst(5)=['amipbc_sst_1x1.nc ','amip_sst_1x1.nc ','cpl_atm_sst.nc '& 32 ,'histmth_sst.nc ','sstk.nc '], & 33 fsic(5)=['amipbc_sic_1x1.nc ','amip_sic_1x1.nc ','cpl_atm_sic.nc '& 34 ,'histmth_sic.nc ','ci.nc '], & 35 vsst(5)=['tosbcs ','tos ','SISUTESW ','tsol_oce ','sstk '], & 36 vsic(5)=['sicbcs ','sic ','SIICECOV ','pourc_sic ','ci '], & 37 frugo='Rugos.nc ', falbe='Albedo.nc ', frelf='Relief.nc ', & 38 vrug='RUGOS ', valb='ALBEDO ', vrel='RELIEF ', & 39 DegK(11)=['degK ','degree_K ','degreeK ','deg_K '& 40 ,'degsK ','degrees_K ','degreesK ','degs_K '& 41 ,'degree_kelvin ','degrees_kelvin','K '], & 42 DegC(10)=['degC ','degree_C ','degreeC ','deg_C '& 43 ,'degsC ','degrees_C ','degreesC ','degs_C '& 44 ,'degree_Celsius','celsius '], & 45 Perc(2) =['% ','percent '], & 46 Frac(2) =['1.0 ','1 '] 47 48 CONTAINS 49 50 !------------------------------------------------------------------------------- 51 52 SUBROUTINE limit_netcdf(masque, phis, extrap) 53 54 !------------------------------------------------------------------------------- 55 ! Author : L. Fairhead, 27/01/94 56 !------------------------------------------------------------------------------- 57 ! Purpose: Boundary conditions files building for new model using climatologies. 58 ! Both grids have to be regular. 59 !------------------------------------------------------------------------------- 60 ! Note: This routine is designed to work for Earth 61 !------------------------------------------------------------------------------- 62 ! Modification history: 63 ! * 23/03/1994: Z. X. Li 64 ! * 09/1999: L. Fairhead (netcdf reading in LMDZ.3.3) 65 ! * 07/2001: P. Le Van 66 ! * 11/2009: L. Guez (ozone day & night climatos, see etat0_netcdf.F90) 67 ! * 12/2009: D. Cugnet (f77->f90, calendars, files from coupled runs) 68 ! * 04/2016: D. Cugnet (12/14 recs SST/SIC files: cyclic/interannual runs) 69 ! * 05/2017: D. Cugnet (linear time interpolation for BCS files) 70 !------------------------------------------------------------------------------- 71 #ifndef CPP_1D 72 USE indice_sol_mod 73 USE netcdf, ONLY: NF90_OPEN, NF90_CREATE, NF90_CLOSE, & 74 NF90_DEF_DIM, NF90_DEF_VAR, NF90_PUT_VAR, NF90_PUT_ATT, & 75 nf90_noerr, NF90_NOWRITE, NF90_GLOBAL, & 76 NF90_CLOBBER, NF90_ENDDEF, NF90_UNLIMITED, NF90_FLOAT, & 77 NF90_64BIT_OFFSET 78 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 79 USE inter_barxy_m, ONLY: inter_barxy 80 USE netcdf95, ONLY: nf95_def_var, nf95_put_att, nf95_put_var 81 USE comconst_mod, ONLY: pi 82 USE phys_cal_mod, ONLY: calend 83 IMPLICIT NONE 84 !------------------------------------------------------------------------------- 85 ! Arguments: 86 include "iniprint.h" 87 include "dimensions.h" 88 include "paramet.h" 89 REAL, DIMENSION(iip1,jjp1), INTENT(INOUT) :: masque ! land mask 90 REAL, DIMENSION(iip1,jjp1), INTENT(INOUT) :: phis ! ground geopotential 91 LOGICAL, INTENT(IN) :: extrap ! SST extrapolation flag 92 !------------------------------------------------------------------------------- 93 ! Local variables: 94 include "comgeom2.h" 95 96 !--- INPUT NETCDF FILES AND VARIABLES NAMES ------------------------------------ 97 CHARACTER(LEN=ns) :: icefile, sstfile, fnam, varname 98 99 !--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------ 100 REAL :: fi_ice(klon) 101 REAL, POINTER :: phy_rug(:,:)=>NULL(), phy_ice(:,:)=>NULL() 102 REAL, POINTER :: phy_sst(:,:)=>NULL(), phy_alb(:,:)=>NULL() 103 REAL, ALLOCATABLE :: phy_bil(:,:), pctsrf_t(:,:,:) 104 INTEGER :: nbad 105 106 !--- VARIABLES FOR OUTPUT FILE WRITING ----------------------------------------- 107 INTEGER :: nid, ndim, ntim, k, dims(2), ix_sic, ix_sst 108 INTEGER :: id_tim, id_SST, id_BILS, id_RUG, id_ALB 109 INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC, varid_longitude, varid_latitude 110 INTEGER :: ndays !--- Depending on the output calendar 111 CHARACTER(LEN=ns) :: str 112 113 !--- INITIALIZATIONS ----------------------------------------------------------- 114 CALL inigeom 115 116 !--- MASK, GROUND GEOPOT. & SUBSURFACES COMPUTATION (IN CASE ok_etat0==.FALSE.) 117 IF(ALL(masque==-99999.)) THEN 118 CALL start_init_orog0(rlonv,rlatu,phis,masque) 119 CALL gr_dyn_fi(1,iip1,jjp1,klon,masque,zmasq) !--- To physical grid 120 ALLOCATE(pctsrf(klon,nbsrf)) 121 CALL start_init_subsurf(.FALSE.) 122 !--- TO MATCH EXACTLY WHAT WOULD BE DONE IN etat0phys_netcdf 123 WHERE( masque(:,:)<EPSFRA) masque(:,:)=0. 124 WHERE(1.-masque(:,:)<EPSFRA) masque(:,:)=1. 125 END IF 126 127 !--- Beware: anneeref (from gcm.def) is used to determine output time sampling 128 ndays=year_len(anneeref) 129 130 !--- RUGOSITY TREATMENT -------------------------------------------------------- 131 CALL msg(0,""); CALL msg(0," *** TRAITEMENT DE LA RUGOSITE ***") 132 CALL get_2Dfield(frugo,vrug,'RUG',ndays,phy_rug,mask=masque(1:iim,:)) 133 134 !--- OCEAN TREATMENT ----------------------------------------------------------- 135 CALL msg(0,""); CALL msg(0," *** TRAITEMENT DE LA GLACE OCEANIQUE ***") 136 137 ! Input SIC file selection 138 ! Open file only to test if available 139 DO ix_sic=1,SIZE(fsic) 140 IF ( NF90_OPEN(TRIM(fsic(ix_sic)),NF90_NOWRITE,nid)==nf90_noerr ) THEN 141 icefile=fsic(ix_sic); varname=vsic(ix_sic); EXIT 142 END IF 143 END DO 144 IF(ix_sic==SIZE(fsic)+1) THEN 145 WRITE(lunout,*) 'ERROR! No sea-ice input file was found.' 146 WRITE(lunout,*) 'One of following files must be available : ' 147 DO k=1,SIZE(fsic); WRITE(lunout,*) TRIM(fsic(k)); END DO 148 CALL abort_physic('limit_netcdf','No sea-ice file was found',1) 149 END IF 150 CALL ncerr(NF90_CLOSE(nid),icefile) 151 CALL msg(0,'Fichier choisi pour la glace de mer:'//TRIM(icefile)) 152 153 CALL get_2Dfield(icefile,varname, 'SIC',ndays,phy_ice) 154 155 ALLOCATE(pctsrf_t(klon,nbsrf,ndays)) 156 DO k=1,ndays 157 fi_ice=phy_ice(:,k) 158 WHERE(fi_ice>=1.0 ) fi_ice=1.0 159 WHERE(fi_ice<EPSFRA) fi_ice=0.0 160 pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter) ! land soil 161 pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic) ! land ice 162 SELECT CASE(ix_sic) 163 CASE(3) ! SIC=pICE*(1-LIC-TER) (CPL) 164 pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter)) 165 CASE(4) ! SIC=pICE (HIST) 166 pctsrf_t(:,is_sic,k)=fi_ice(:) 167 CASE DEFAULT ! SIC=pICE-LIC (AMIP,ERAI) 168 pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k) 169 END SELECT 170 WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0. 171 WHERE(1.0-zmasq<EPSFRA) 172 pctsrf_t(:,is_sic,k)=0.0 173 pctsrf_t(:,is_oce,k)=0.0 174 ELSEWHERE 175 WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq) 176 pctsrf_t(:,is_sic,k)=1.0-zmasq 177 pctsrf_t(:,is_oce,k)=0.0 178 ELSEWHERE 179 pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k) 180 WHERE(pctsrf_t(:,is_oce,k)<EPSFRA) 181 pctsrf_t(:,is_oce,k)=0.0 182 pctsrf_t(:,is_sic,k)=1.0-zmasq 183 END WHERE 184 END WHERE 185 END WHERE 186 nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0) 187 IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb points = ',nbad 188 nbad=COUNT(ABS(SUM(pctsrf_t(:,:,k),DIM=2)-1.0)>EPSFRA) 189 IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad 190 END DO 191 DEALLOCATE(phy_ice) 192 193 !--- SST TREATMENT ------------------------------------------------------------- 194 CALL msg(0,""); CALL msg(0," *** TRAITEMENT DE LA SST ***") 195 196 ! Input SST file selection 197 ! Open file only to test if available 198 DO ix_sst=1,SIZE(fsst) 199 IF ( NF90_OPEN(TRIM(fsst(ix_sst)),NF90_NOWRITE,nid)==nf90_noerr ) THEN 200 sstfile=fsst(ix_sst); varname=vsst(ix_sst); EXIT 201 END IF 202 END DO 203 IF(ix_sst==SIZE(fsst)+1) THEN 204 WRITE(lunout,*) 'ERROR! No sst input file was found.' 205 WRITE(lunout,*) 'One of following files must be available : ' 206 DO k=1,SIZE(fsst); WRITE(lunout,*) TRIM(fsst(k)); END DO 207 CALL abort_physic('limit_netcdf','No sst file was found',1) 208 END IF 209 CALL ncerr(NF90_CLOSE(nid),sstfile) 210 CALL msg(0,'Fichier choisi pour la temperature de mer: '//TRIM(sstfile)) 211 212 CALL get_2Dfield(sstfile,varname,'SST',ndays,phy_sst,flag=extrap) 213 214 !--- ALBEDO TREATMENT ---------------------------------------------------------- 215 CALL msg(0,""); CALL msg(0," *** TRAITEMENT DE L'ALBEDO ***") 216 CALL get_2Dfield(falbe,valb,'ALB',ndays,phy_alb) 217 218 !--- REFERENCE GROUND HEAT FLUX TREATMENT -------------------------------------- 219 ALLOCATE(phy_bil(klon,ndays)); phy_bil=0.0 220 221 !--- OUTPUT FILE WRITING ------------------------------------------------------- 222 CALL msg(0,""); CALL msg(0,' *** Ecriture du fichier limit : debut ***') 223 fnam="limit.nc" 224 225 !--- File creation 226 CALL ncerr(NF90_CREATE(fnam,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET),nid),fnam) 227 CALL ncerr(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier conditions aux limites"),fnam) 228 str='File produced using ce0l executable.' 229 str=TRIM(str)//NEW_LINE(' ')//'Sea Ice Concentration built from' 230 SELECT CASE(ix_sic) 231 CASE(1); str=TRIM(str)//' Amip mid-month boundary condition (BCS).' 232 CASE(2); str=TRIM(str)//' Amip monthly mean observations.' 233 CASE(3); str=TRIM(str)//' IPSL coupled model outputs.' 234 CASE(4); str=TRIM(str)//' LMDZ model outputs.' 235 CASE(5); str=TRIM(str)//' ci.nc file.' 236 END SELECT 237 str=TRIM(str)//NEW_LINE(' ')//'Sea Surface Temperature built from' 238 SELECT CASE(ix_sst) 239 CASE(1); str=TRIM(str)//' Amip mid-month boundary condition (BCS).' 240 CASE(2); str=TRIM(str)//' Amip monthly mean observations.' 241 CASE(3); str=TRIM(str)//' IPSL coupled model outputs.' 242 CASE(4); str=TRIM(str)//' LMDZ model outputs.' 243 CASE(5); str=TRIM(str)//' sstk.nc file.' 244 END SELECT 245 CALL ncerr(NF90_PUT_ATT(nid,NF90_GLOBAL,"history",TRIM(str)),fnam) 246 247 !--- Dimensions creation 248 CALL ncerr(NF90_DEF_DIM(nid,"points_physiques",klon,ndim),fnam) 249 CALL ncerr(NF90_DEF_DIM(nid,"time",NF90_UNLIMITED,ntim),fnam) 250 251 dims=[ndim,ntim] 252 253 !--- Variables creation 254 CALL ncerr(NF90_DEF_VAR(nid,"TEMPS",nf90_format,[ntim],id_tim),fnam) 255 CALL ncerr(NF90_DEF_VAR(nid,"FOCE", nf90_format,dims,id_FOCE),fnam) 256 CALL ncerr(NF90_DEF_VAR(nid,"FSIC", nf90_format,dims,id_FSIC),fnam) 257 CALL ncerr(NF90_DEF_VAR(nid,"FTER", nf90_format,dims,id_FTER),fnam) 258 CALL ncerr(NF90_DEF_VAR(nid,"FLIC", nf90_format,dims,id_FLIC),fnam) 259 CALL ncerr(NF90_DEF_VAR(nid,"SST", nf90_format,dims,id_SST),fnam) 260 CALL ncerr(NF90_DEF_VAR(nid,"BILS", nf90_format,dims,id_BILS),fnam) 261 CALL ncerr(NF90_DEF_VAR(nid,"ALB", nf90_format,dims,id_ALB),fnam) 262 CALL ncerr(NF90_DEF_VAR(nid,"RUG", nf90_format,dims,id_RUG),fnam) 263 call nf95_def_var(nid, "longitude", NF90_FLOAT, ndim, varid_longitude) 264 call nf95_def_var(nid, "latitude", NF90_FLOAT, ndim, varid_latitude) 265 266 !--- Attributes creation 267 CALL ncerr(NF90_PUT_ATT(nid,id_tim, "title","Jour dans l annee"),fnam) 268 CALL ncerr(NF90_PUT_ATT(nid,id_tim, "calendar",calend),fnam) 269 CALL ncerr(NF90_PUT_ATT(nid,id_FOCE,"title","Fraction ocean"),fnam) 270 CALL ncerr(NF90_PUT_ATT(nid,id_FSIC,"title","Fraction glace de mer"),fnam) 271 CALL ncerr(NF90_PUT_ATT(nid,id_FTER,"title","Fraction terre"),fnam) 272 CALL ncerr(NF90_PUT_ATT(nid,id_FLIC,"title","Fraction land ice"),fnam) 273 CALL ncerr(NF90_PUT_ATT(nid,id_SST ,"title","Temperature superficielle de la mer"),fnam) 274 CALL ncerr(NF90_PUT_ATT(nid,id_BILS,"title","Reference flux de chaleur au sol"),fnam) 275 CALL ncerr(NF90_PUT_ATT(nid,id_ALB, "title","Albedo a la surface"),fnam) 276 CALL ncerr(NF90_PUT_ATT(nid,id_RUG, "title","Rugosite"),fnam) 277 278 call nf95_put_att(nid, varid_longitude, "standard_name", "longitude") 279 call nf95_put_att(nid, varid_longitude, "units", "degrees_east") 280 281 call nf95_put_att(nid, varid_latitude, "standard_name", "latitude") 282 call nf95_put_att(nid, varid_latitude, "units", "degrees_north") 283 284 CALL ncerr(NF90_ENDDEF(nid),fnam) 285 286 !--- Variables saving 287 CALL ncerr(NF90_PUT_VAR(nid,id_tim,[(REAL(k),k=1,ndays)]),fnam) 288 CALL ncerr(NF90_PUT_VAR(nid,id_FOCE,pctsrf_t(:,is_oce,:),[1,1],[klon,ndays]),fnam) 289 CALL ncerr(NF90_PUT_VAR(nid,id_FSIC,pctsrf_t(:,is_sic,:),[1,1],[klon,ndays]),fnam) 290 CALL ncerr(NF90_PUT_VAR(nid,id_FTER,pctsrf_t(:,is_ter,:),[1,1],[klon,ndays]),fnam) 291 CALL ncerr(NF90_PUT_VAR(nid,id_FLIC,pctsrf_t(:,is_lic,:),[1,1],[klon,ndays]),fnam) 292 CALL ncerr(NF90_PUT_VAR(nid,id_SST ,phy_sst(:,:),[1,1],[klon,ndays]),fnam) 293 CALL ncerr(NF90_PUT_VAR(nid,id_BILS,phy_bil(:,:),[1,1],[klon,ndays]),fnam) 294 CALL ncerr(NF90_PUT_VAR(nid,id_ALB ,phy_alb(:,:),[1,1],[klon,ndays]),fnam) 295 CALL ncerr(NF90_PUT_VAR(nid,id_RUG ,phy_rug(:,:),[1,1],[klon,ndays]),fnam) 296 call nf95_put_var(nid, varid_longitude, longitude_deg) 297 call nf95_put_var(nid, varid_latitude, latitude_deg) 298 299 CALL ncerr(NF90_CLOSE(nid),fnam) 300 301 CALL msg(0,""); CALL msg(0,' *** Ecriture du fichier limit : fin ***') 302 303 DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug) 304 305 306 !=============================================================================== 307 308 CONTAINS 309 310 !=============================================================================== 311 312 313 !------------------------------------------------------------------------------- 314 315 SUBROUTINE get_2Dfield(fnam, varname, mode, ndays, champo, flag, mask) 316 317 !----------------------------------------------------------------------------- 318 ! Comments: 319 ! There are two assumptions concerning the NetCDF files, that are satisfied 320 ! with files that are conforming NC convention: 321 ! 1) The last dimension of the variables used is the time record. 322 ! 2) Dimensional variables have the same names as corresponding dimensions. 323 !----------------------------------------------------------------------------- 324 USE netcdf, ONLY: NF90_OPEN, NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, & 325 NF90_CLOSE, nf90_inq_dimid, nf90_inquire_dimension, nf90_get_var, & 326 NF90_GET_ATT 327 USE pchsp_95_m, only: pchsp_95 328 USE pchfe_95_m, only: pchfe_95 329 USE arth_m, only: arth 330 USE indice_sol_mod 331 332 IMPLICIT NONE 333 include "dimensions.h" 334 include "paramet.h" 335 include "comgeom2.h" 336 !----------------------------------------------------------------------------- 337 ! Arguments: 338 CHARACTER(LEN=*), INTENT(IN) :: fnam ! NetCDF file name 339 CHARACTER(LEN=*), INTENT(IN) :: varname ! NetCDF variable name 340 CHARACTER(LEN=*), INTENT(IN) :: mode ! RUG, SIC, SST or ALB 341 INTEGER, INTENT(IN) :: ndays ! current year number of days 342 REAL, POINTER, DIMENSION(:, :) :: champo ! output field = f(t) 343 LOGICAL, OPTIONAL, INTENT(IN) :: flag ! extrapol. (SST) old ice (SIC) 344 REAL, OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask 345 !------------------------------------------------------------------------------ 346 ! Local variables: 347 !--- NetCDF 348 INTEGER :: ncid, varid ! NetCDF identifiers 349 CHARACTER(LEN=ns) :: dnam ! dimension name 350 !--- dimensions 351 INTEGER :: dids(4) ! NetCDF dimensions identifiers 352 REAL, ALLOCATABLE :: dlon_ini(:) ! initial longitudes vector 353 REAL, ALLOCATABLE :: dlat_ini(:) ! initial latitudes vector 354 REAL, POINTER :: dlon(:), dlat(:) ! reordered lon/lat vectors 355 !--- fields 356 INTEGER :: imdep, jmdep, lmdep ! dimensions of 'champ' 357 REAL, ALLOCATABLE :: champ(:,:) ! wanted field on initial grid 358 REAL, ALLOCATABLE :: yder(:), timeyear(:) 359 REAL :: champint(iim,jjp1) ! interpolated field 360 REAL, ALLOCATABLE :: champtime(:,:,:) 361 REAL, ALLOCATABLE :: champan(:,:,:) 362 !--- input files 363 CHARACTER(LEN=ns) :: fnam_m, fnam_p ! previous/next files names 364 CHARACTER(LEN=ns) :: cal_in ! calendar 365 CHARACTER(LEN=ns) :: units ! attribute "units" in sic/sst file 366 INTEGER :: ndays_in ! number of days 367 REAL :: value ! mean/max value near equator 368 !--- misc 369 INTEGER :: i, j, k, l ! loop counters 370 REAL, ALLOCATABLE :: work(:,:) ! used for extrapolation 371 CHARACTER(LEN=ns) :: title, mess ! for messages 372 LOGICAL :: is_bcs ! flag for BCS data 373 LOGICAL :: extrp ! flag for extrapolation 374 LOGICAL :: ll 375 REAL :: chmin, chmax, timeday, al 376 INTEGER ierr, idx 377 integer n_extrap ! number of extrapolated points 378 logical skip 379 380 !------------------------------------------------------------------------------ 381 !---Variables depending on keyword 'mode' ------------------------------------- 382 NULLIFY(champo) 383 384 SELECT CASE(mode) 385 CASE('RUG'); title='Rugosite' 386 CASE('SIC'); title='Sea-ice' 387 CASE('SST'); title='SST' 388 CASE('ALB'); title='Albedo' 389 END SELECT 390 extrp=.FALSE.; IF(PRESENT(flag).AND.mode=='SST') extrp=flag 391 is_bcs=(mode=='SIC'.AND.ix_sic==1).OR.(mode=='SST'.AND.ix_sst==1) 392 idx=INDEX(fnam,'.nc')-1 393 394 !--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE ----------------------------- 395 CALL msg(5,' Now reading file : '//TRIM(fnam)) 396 CALL ncerr(NF90_OPEN(fnam, NF90_NOWRITE, ncid),fnam) 397 CALL ncerr(NF90_INQ_VARID(ncid, trim(varname), varid),fnam) 398 CALL ncerr(NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids),fnam) 399 400 !--- Longitude 401 CALL ncerr(nf90_inquire_dimension(ncid, dids(1), name=dnam, len=imdep),fnam) 402 ALLOCATE(dlon_ini(imdep), dlon(imdep)) 403 CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam) 404 CALL ncerr(nf90_get_var(ncid, varid, dlon_ini), fnam) 405 CALL msg(5,'variable '//TRIM(dnam)//' dimension ', imdep) 406 407 !--- Latitude 408 CALL ncerr(nf90_inquire_dimension(ncid, dids(2), name=dnam, len=jmdep),fnam) 409 ALLOCATE(dlat_ini(jmdep), dlat(jmdep)) 410 CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam) 411 CALL ncerr(nf90_get_var(ncid, varid, dlat_ini), fnam) 412 CALL msg(5,'variable '//TRIM(dnam)//' dimension ', jmdep) 413 414 !--- Time (variable is not needed - it is rebuilt - but calendar is) 415 CALL ncerr(nf90_inquire_dimension(ncid, dids(3), name=dnam, len=lmdep), fnam) 416 ALLOCATE(timeyear(lmdep+2)) 417 CALL ncerr(NF90_INQ_VARID(ncid, dnam, varid), fnam) 418 cal_in=' ' 419 IF(NF90_GET_ATT(ncid, varid, 'calendar', cal_in)/=nf90_noerr) THEN 420 SELECT CASE(mode) 421 CASE('RUG', 'ALB'); cal_in='360_day' 422 CASE('SIC', 'SST'); cal_in='gregorian' 423 END SELECT 424 CALL msg(0,'WARNING: missing "calendar" attribute for "time" in '& 425 //TRIM(fnam)//'. Choosing default value.') 426 END IF 427 CALL strclean(cal_in) !--- REMOVE (WEIRD) NULL CHARACTERS 428 CALL msg(0,'var, calendar, dim: '//TRIM(dnam)//' '//TRIM(cal_in), lmdep) 429 430 !--- Determining input file number of days, depending on calendar 431 ndays_in=year_len(anneeref, cal_in) 432 433 !--- Rebuilding input time vector (field from input file might be unreliable) 434 IF(lmdep==12) THEN 435 timeyear=mid_month(anneeref, cal_in) 436 CALL msg(0,'Monthly input file(s) for '//TRIM(title)//'.') 437 ELSE IF(lmdep==ndays_in) THEN 438 timeyear=[(REAL(k)-0.5,k=0,ndays_in+1)] 439 CALL msg(0,'Daily input file (no time interpolation).') 440 ELSE 441 WRITE(mess,'(a,i3,a,i3,a)')'Mismatching input file: found',lmdep, & 442 ' records, 12/',ndays_in,' (monthly/daily needed).' 443 CALL abort_physic('mid_month',TRIM(mess),1) 444 END IF 445 446 !--- GETTING THE FIELD AND INTERPOLATING IT ---------------------------------- 447 ALLOCATE(champ(imdep, jmdep), champtime(iim, jjp1, lmdep+2)) 448 IF(extrp) ALLOCATE(work(imdep, jmdep)) 449 CALL msg(5,'') 450 CALL msg(5,'READ AND INTERPOLATE HORIZONTALLY ', lmdep, ' FIELDS.') 451 CALL ncerr(NF90_INQ_VARID(ncid, varname, varid), fnam) 452 DO l=1, lmdep 453 CALL ncerr(nf90_get_var(ncid,varid,champ,[1,1,l],[imdep,jmdep,1]),fnam) 454 CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.) 455 456 !--- FOR SIC/SST FIELDS ONLY 457 IF(l==1.AND.is_in(mode,['SIC','SST'])) THEN 458 459 !--- DETERMINE THE UNIT: READ FROM FILE OR ASSUMED USING FIELD VALUES 460 ierr=NF90_GET_ATT(ncid, varid, 'units', units) 461 IF(ierr==nf90_noerr) THEN !--- ATTRIBUTE "units" FOUND IN THE FILE 462 CALL strclean(units) 463 IF(mode=='SIC'.AND.is_in(units,Perc)) units="%" 464 IF(mode=='SIC'.AND.is_in(units,Frac)) units="1" 465 IF(mode=='SST'.AND.is_in(units,DegC)) units="C" 466 IF(mode=='SST'.AND.is_in(units,DegK)) units="K" 467 ELSE !--- CHECK THE FIELD VALUES 468 IF(mode=='SIC') value=MAXVAL(champ(:,:)) 469 IF(mode=='SST') value= SUM(champ(:,jmdep/2),DIM=1)/REAL(imdep) 470 IF(mode=='SIC') THEN; units="1"; IF(value>= 10.) units="%"; END IF 471 IF(mode=='SST') THEN; units="C"; IF(value>=100.) units="K"; END IF 472 END IF 473 CALL msg(0,'INPUT FILE '//TRIM(title)//' UNIT IS: "'//TRIM(units)//'".') 474 IF(ierr/=nf90_noerr) CALL msg(0,'WARNING ! UNIT TO BE CHECKED ! ' & 475 //'No "units" attribute, so only based on the fields values.') 476 477 !--- CHECK VALUES ARE IN THE EXPECTED RANGE 478 SELECT CASE(units) 479 CASE('%'); ll=ANY(champ>100.0+EPSFRA); str='percentages > 100.' 480 CASE('1'); ll=ANY(champ> 1.0+EPSFRA); str='fractions > 1.' 481 CASE('C'); ll=ANY(champ<-100.).OR.ANY(champ> 60.); str='<-100 or >60 DegC' 482 CASE('K'); ll=ANY(champ< 180.).OR.ANY(champ>330.); str='<180 or >330 DegK' 483 CASE DEFAULT; CALL abort_physic(mode, 'Unrecognized '//TRIM(title) & 484 //' unit: '//TRIM(units),1) 485 END SELECT 486 487 !--- DROPPED FOR BCS DATA (FRACTIONS CAN BE HIGHER THAN 1) 488 IF(ll.AND.ix_sic/=1.AND.mode=='SIC') & 489 CALL abort_physic(mode,'unrealistic '//TRIM(mode)//' found: '//TRIM(str), 1) 490 491 END IF 492 493 IF(extrp) CALL extrapol(champ,imdep,jmdep,999999.,.TRUE.,.TRUE.,2,work) 494 IF(l==1) THEN 495 CALL msg(5,"--------------------------------------------------------") 496 CALL msg(5,"$$$ Barycentric interpolation for "//TRIM(title)//" $$$") 497 CALL msg(5,"--------------------------------------------------------") 498 END IF 499 IF(mode=='RUG') champ=LOG(champ) 500 CALL inter_barxy(dlon,dlat(:jmdep-1),champ,rlonu(:iim),rlatv,champint) 501 IF(mode=='RUG') THEN 502 champint=EXP(champint) 503 WHERE(NINT(mask)/=1) champint=0.001 504 END IF 505 champtime(:, :, l+1)=champint 506 END DO 507 CALL ncerr(NF90_CLOSE(ncid), fnam) 508 509 !--- FIRST RECORD: LAST ONE OF PREVIOUS YEAR (CURRENT YEAR IF UNAVAILABLE) 510 fnam_m=fnam(1:idx)//'_m.nc' 511 IF(NF90_OPEN(fnam_m,NF90_NOWRITE,ncid)==nf90_noerr) THEN 512 CALL msg(0,'Reading previous year file ("'//TRIM(fnam_m)//'") last record for '//TRIM(title)) 513 CALL ncerr(NF90_INQ_VARID(ncid, varname, varid),fnam_m) 514 CALL ncerr(NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids),fnam_m) 515 CALL ncerr(nf90_inquire_dimension(ncid, dids(3), len=l), fnam_m) 516 CALL ncerr(nf90_get_var(ncid,varid,champ,[1,1,l],[imdep,jmdep,1]),fnam_m) 517 CALL ncerr(NF90_CLOSE(ncid), fnam_m) 518 CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.) 519 IF(extrp) CALL extrapol(champ,imdep,jmdep,999999.,.TRUE.,.TRUE.,2,work) 520 IF(mode=='RUG') champ=LOG(champ) 521 CALL inter_barxy(dlon,dlat(:jmdep-1),champ,rlonu(:iim),rlatv,champint) 522 IF(mode=='RUG') THEN 523 champint=EXP(champint) 524 WHERE(NINT(mask)/=1) champint=0.001 525 END IF 526 champtime(:, :, 1)=champint 527 ELSE 528 CALL msg(0,'Using current year file ("'//TRIM(fnam)//'") last record for '//TRIM(title)) 529 champtime(:, :, 1)=champtime(:, :, lmdep+1) 530 END IF 531 532 !--- LAST RECORD: FIRST ONE OF NEXT YEAR (CURRENT YEAR IF UNAVAILABLE) 533 fnam_p=fnam(1:idx)//'_p.nc' 534 IF(NF90_OPEN(fnam_p,NF90_NOWRITE,ncid)==nf90_noerr) THEN 535 CALL msg(0,'Reading next year file ("'//TRIM(fnam_p)//'") first record for '//TRIM(title)) 536 CALL ncerr(NF90_INQ_VARID(ncid, varname, varid),fnam_p) 537 CALL ncerr(nf90_get_var(ncid,varid,champ,[1,1,1],[imdep,jmdep,1]),fnam_p) 538 CALL ncerr(NF90_CLOSE(ncid), fnam_p) 539 CALL conf_dat2d(title, dlon_ini, dlat_ini, dlon, dlat, champ, .TRUE.) 540 IF(extrp) CALL extrapol(champ,imdep,jmdep,999999.,.TRUE.,.TRUE.,2,work) 541 IF(mode=='RUG') champ=LOG(champ) 542 CALL inter_barxy(dlon,dlat(:jmdep-1),champ,rlonu(:iim),rlatv,champint) 543 IF(mode=='RUG') THEN 544 champint=EXP(champint) 545 WHERE(NINT(mask)/=1) champint=0.001 546 END IF 547 champtime(:, :, lmdep+2)=champint 548 ELSE 549 CALL msg(0,'Using current year file ("'//TRIM(fnam)//'") first record for '//TRIM(title)) 550 champtime(:, :, lmdep+2)=champtime(:, :, 2) 551 END IF 552 DEALLOCATE(dlon_ini, dlat_ini, dlon, dlat, champ) 553 IF(extrp) DEALLOCATE(work) 554 555 !--- TIME INTERPOLATION ------------------------------------------------------ 556 IF(prt_level>0) THEN 557 IF(ndays/=ndays_in) THEN 558 WRITE(lunout,*)'DIFFERENT YEAR LENGTHS:' 559 WRITE(lunout,*)' In the input file: ',ndays_in 560 WRITE(lunout,*)' In the output file: ',ndays 561 END IF 562 IF(lmdep==ndays_in) THEN 563 WRITE(lunout, *)'NO TIME INTERPOLATION.' 564 WRITE(lunout, *)' Daily input file.' 565 ELSE 566 IF( is_bcs) WRITE(lunout, *)'LINEAR TIME INTERPOLATION.' 567 IF(.NOT.is_bcs) WRITE(lunout, *)'SPLINES TIME INTERPOLATION.' 568 WRITE(lunout, *)' Input time vector: ', timeyear 569 WRITE(lunout, *)' Output time vector: from 0.5 to ', ndays-0.5 570 END IF 571 END IF 572 ALLOCATE(champan(iip1, jjp1, ndays)) 573 574 IF(lmdep==ndays_in) THEN !--- DAILY DATA: NO TIME INTERPOLATION 575 DO l=1,lmdep 576 champan(1:iim,:,l)=champtime(:,:,l+1) 577 END DO 578 ELSE IF(is_bcs) THEN !--- BCS DATA: LINEAR TIME INTERPOLATION 579 l=1 580 DO k=1, ndays 581 timeday = (REAL(k)-0.5)*REAL(ndays_in)/ndays 582 IF(timeyear(l+1)<timeday) l=l+1 583 al=(timeday-timeyear(l))/(timeyear(l+1)-timeyear(l)) 584 champan(1:iim,:,k) = champtime(1:iim,:,l)+al*(champtime(1:iim,:,l+1)-champtime(1:iim,:,l)) 585 END DO 586 ELSE !--- AVE DATA: SPLINE TIME INTERPOLATION 587 skip = .false. 588 n_extrap = 0 589 ALLOCATE(yder(lmdep+2)) 590 DO j=1, jjp1 591 DO i=1, iim 592 yder = pchsp_95(timeyear, champtime(i, j, :), ibeg=2, iend=2, & 593 vc_beg=0., vc_end=0.) 594 CALL pchfe_95(timeyear, champtime(i, j, :), yder, skip, & 595 arth(0.5, real(ndays_in) / ndays, ndays), champan(i, j, :), ierr) 596 if (ierr < 0) call abort_physic("get_2Dfield", "", 1) 597 n_extrap = n_extrap + ierr 598 END DO 599 END DO 600 IF(n_extrap /= 0) WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap 601 DEALLOCATE(yder) 602 END IF 603 champan(iip1, :, :)=champan(1, :, :) 604 DEALLOCATE(champtime, timeyear) 605 606 !--- Checking the result 607 DO j=1, jjp1 608 CALL minmax(iip1, champan(1, j, 10), chmin, chmax) 609 IF (prt_level>5) WRITE(lunout, *)' ',TRIM(title),' at time 10 ', chmin, chmax, j 610 END DO 611 612 !--- SPECIAL FILTER FOR SST: SST>271.38 -------------------------------------- 613 IF(mode=='SST') THEN 614 SELECT CASE(units) 615 CASE("K"); CALL msg(0,'SST field is already in kelvins.') 616 CASE("C"); CALL msg(0,'SST field converted from celcius degrees to kelvins.') 617 champan(:, :, :)=champan(:, :, :)+273.15 618 END SELECT 619 CALL msg(0,'Filtering SST: Sea Surface Temperature >= 271.38') 620 WHERE(champan<271.38) champan=271.38 621 END IF 622 623 !--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 ------------------------------------- 624 IF(mode=='SIC') THEN 625 SELECT CASE(units) 626 CASE("1"); CALL msg(0,'SIC field already in fraction of 1') 627 CASE("%"); CALL msg(0,'SIC field converted from percentage to fraction of 1.') 628 champan(:, :, :)=champan(:, :, :)/100. 629 END SELECT 630 CALL msg(0,'Filtering SIC: 0.0 <= Sea-ice <=1.0') 631 WHERE(champan>1.0) champan=1.0 632 WHERE(champan<0.0) champan=0.0 633 END IF 634 635 !--- DYNAMICAL TO PHYSICAL GRID ---------------------------------------------- 636 ALLOCATE(champo(klon, ndays)) 637 DO k=1, ndays 638 CALL gr_dyn_fi(1, iip1, jjp1, klon, champan(1, 1, k), champo(:, k)) 639 END DO 640 DEALLOCATE(champan) 641 642 END SUBROUTINE get_2Dfield 643 644 !------------------------------------------------------------------------------- 645 646 647 !------------------------------------------------------------------------------- 648 649 SUBROUTINE start_init_orog0(lon_in,lat_in,phis,masque) 650 651 !------------------------------------------------------------------------------- 652 USE grid_noro_m, ONLY: grid_noro0 653 IMPLICIT NONE 654 !=============================================================================== 655 ! Purpose: Compute "phis" just like it would be in start_init_orog. 656 !=============================================================================== 657 ! Arguments: 658 REAL, INTENT(IN) :: lon_in(:), lat_in(:) ! dim (iml) (jml) 659 REAL, INTENT(INOUT) :: phis(:,:), masque(:,:) ! dim (iml,jml) 660 !------------------------------------------------------------------------------- 661 ! Local variables: 662 CHARACTER(LEN=ns) :: modname="start_init_orog0" 663 INTEGER :: fid, llm_tmp,ttm_tmp, iml,jml, iml_rel,jml_rel, itau(1) 664 REAL :: lev(1), date, dt, deg2rad 665 REAL, ALLOCATABLE :: lon_rad(:), lon_ini(:), lon_rel(:,:), relief_hi(:,:) 666 REAL, ALLOCATABLE :: lat_rad(:), lat_ini(:), lat_rel(:,:) 667 !------------------------------------------------------------------------------- 668 iml=assert_eq(SIZE(lon_in),SIZE(phis,1),SIZE(masque,1),TRIM(modname)//" iml") 669 jml=assert_eq(SIZE(lat_in),SIZE(phis,2),SIZE(masque,2),TRIM(modname)//" jml") 670 IF(iml/=iip1) CALL abort_gcm(TRIM(modname),'iml/=iip1',1) 671 IF(jml/=jjp1) CALL abort_gcm(TRIM(modname),'jml/=jjp1',1) 672 pi=2.0*ASIN(1.0); deg2rad=pi/180.0 673 IF(ANY(phis/=-99999.)) RETURN !--- phis ALREADY KNOWN 674 675 !--- HIGH RESOLUTION OROGRAPHY 676 CALL flininfo(frelf, iml_rel, jml_rel, llm_tmp, ttm_tmp, fid) 677 678 ALLOCATE(lat_rel(iml_rel,jml_rel),lon_rel(iml_rel,jml_rel)) 679 CALL flinopen(frelf, .FALSE., iml_rel, jml_rel, llm_tmp, lon_rel, lat_rel, & 680 lev, ttm_tmp, itau, date, dt, fid) 681 ALLOCATE(relief_hi(iml_rel,jml_rel)) 682 CALL flinget(fid, vrel, iml_rel, jml_rel, llm_tmp, ttm_tmp, 1, 1, relief_hi) 683 CALL flinclo(fid) 684 685 !--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS 686 ALLOCATE(lon_ini(iml_rel),lat_ini(jml_rel)) 687 lon_ini(:)=lon_rel(:,1); IF(MAXVAL(lon_rel)>pi) lon_ini=lon_ini*deg2rad 688 lat_ini(:)=lat_rel(1,:); IF(MAXVAL(lat_rel)>pi) lat_ini=lat_ini*deg2rad 689 690 !--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS 691 ALLOCATE(lon_rad(iml_rel),lat_rad(jml_rel)) 692 CALL conf_dat2d(vrel, lon_ini, lat_ini, lon_rad, lat_rad, relief_hi, .FALSE.) 693 DEALLOCATE(lon_ini,lat_ini) 694 695 !--- COMPUTING SURFACE GEOPOTENTIAL USING ROUTINE grid_noro0 696 WRITE(lunout,*) 697 WRITE(lunout,*)'*** Compute surface geopotential ***' 698 699 !--- CALL OROGRAPHY MODULE (REDUCED VERSION) TO COMPUTE FIELDS 700 CALL grid_noro0(lon_rad, lat_rad, relief_hi, lon_in, lat_in, phis, masque) 701 phis = phis * 9.81 702 phis(iml,:) = phis(1,:) 703 DEALLOCATE(relief_hi,lon_rad,lat_rad) 704 705 END SUBROUTINE start_init_orog0 706 707 !------------------------------------------------------------------------------- 708 709 710 !------------------------------------------------------------------------------- 711 712 SUBROUTINE msg(lev,str1,i,str2) 713 714 !------------------------------------------------------------------------------- 715 ! Arguments: 716 INTEGER, INTENT(IN) :: lev 717 CHARACTER(LEN=*), INTENT(IN) :: str1 718 INTEGER, OPTIONAL, INTENT(IN) :: i 719 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: str2 720 !------------------------------------------------------------------------------- 721 IF(prt_level>=lev) THEN 722 IF(PRESENT(str2)) THEN 723 WRITE(lunout,*) TRIM(str1), i, TRIM(str2) 724 ELSE IF(PRESENT(i)) THEN 725 WRITE(lunout,*) TRIM(str1), i 726 ELSE 727 WRITE(lunout,*) TRIM(str1) 728 END IF 729 END IF 730 731 END SUBROUTINE msg 732 733 !------------------------------------------------------------------------------- 734 735 736 !------------------------------------------------------------------------------- 737 738 SUBROUTINE ncerr(ncres,fnam) 739 740 !------------------------------------------------------------------------------- 741 ! Purpose: NetCDF errors handling. 742 !------------------------------------------------------------------------------- 743 USE netcdf, ONLY : nf90_noerr, NF90_STRERROR 744 IMPLICIT NONE 745 !------------------------------------------------------------------------------- 746 ! Arguments: 747 INTEGER, INTENT(IN) :: ncres 748 CHARACTER(LEN=*), INTENT(IN) :: fnam 749 !------------------------------------------------------------------------------- 750 IF(ncres/=nf90_noerr) THEN 751 WRITE(lunout,*)'Problem with file '//TRIM(fnam)//' in routine limit_netcdf.' 752 CALL abort_physic('limit_netcdf',NF90_STRERROR(ncres),1) 753 END IF 754 755 END SUBROUTINE ncerr 756 757 !------------------------------------------------------------------------------- 758 759 760 !------------------------------------------------------------------------------- 761 762 SUBROUTINE strclean(s) 763 764 !------------------------------------------------------------------------------- 765 IMPLICIT NONE 766 !------------------------------------------------------------------------------- 767 ! Purpose: Remove tail null characters from the input string. 768 !------------------------------------------------------------------------------- 769 ! Parameters: 770 CHARACTER(LEN=*), INTENT(INOUT) :: s 771 !------------------------------------------------------------------------------- 772 ! Local variable: 773 INTEGER :: k 774 !------------------------------------------------------------------------------- 775 k=LEN_TRIM(s); DO WHILE(ICHAR(s(k:k))==0); s(k:k)=' '; k=LEN_TRIM(s); END DO 776 777 END SUBROUTINE strclean 778 779 !------------------------------------------------------------------------------- 780 781 782 !------------------------------------------------------------------------------- 783 784 FUNCTION is_in(s1,s2) RESULT(res) 785 786 !------------------------------------------------------------------------------- 787 IMPLICIT NONE 788 !------------------------------------------------------------------------------- 789 ! Purpose: Check wether s1 is present in the s2(:) list (case insensitive). 790 !------------------------------------------------------------------------------- 791 ! Arguments: 792 CHARACTER(LEN=*), INTENT(IN) :: s1, s2(:) 793 LOGICAL :: res 794 !------------------------------------------------------------------------------- 795 res=.FALSE.; DO k=1,SIZE(s2); res=res.OR.strLow(s1)==strLow(s2(k)); END DO 796 797 END FUNCTION is_in 798 799 !------------------------------------------------------------------------------- 800 801 802 !------------------------------------------------------------------------------- 803 804 ELEMENTAL FUNCTION strLow(s) RESULT(res) 805 806 !------------------------------------------------------------------------------- 807 IMPLICIT NONE 808 !------------------------------------------------------------------------------- 809 ! Purpose: Lower case conversion. 810 !------------------------------------------------------------------------------- 811 ! Arguments: 812 CHARACTER(LEN=*), INTENT(IN) :: s 813 CHARACTER(LEN=ns) :: res 814 !------------------------------------------------------------------------------- 815 ! Local variable: 816 INTEGER :: k, ix 817 !------------------------------------------------------------------------------- 818 res=s 819 DO k=1,LEN(s); ix=IACHAR(s(k:k)) 820 IF(64<ix.AND.ix<91) res(k:k)=ACHAR(ix+32) 821 END DO 822 823 END FUNCTION strLow 824 825 !------------------------------------------------------------------------------- 826 827 #endif 828 ! of #ifndef CPP_1D 829 END SUBROUTINE limit_netcdf 830 831 END MODULE limit 832 833 !******************************************************************************* 834 837 -
LMDZ6/branches/Amaury_dev/libf/phylmd/create_etat0_unstruct_mod.F90
r5099 r5100 23 23 SUBROUTINE init_create_etat0_unstruct 24 24 USE lmdz_xios 25 USE netcdf, ONLY: NF90_NOWRITE,nf90_close,nf90_noerr,nf90_open25 USE netcdf, ONLY: nf90_nowrite,nf90_close,nf90_noerr,nf90_open 26 26 USE mod_phys_lmdz_para 27 27 IMPLICIT NONE … … 31 31 IF (is_omp_master) THEN 32 32 33 IF ( NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==nf90_noerr) THEN33 IF (nf90_open("ocean_fraction.nc", nf90_nowrite, file_id)==nf90_noerr) THEN 34 34 CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.) 35 35 CALL xios_set_field_attr("mask",field_ref="frac_ocean_read") 36 iret= NF90_CLOSE(file_id)37 ELSE IF ( NF90_OPEN("land_water_0.05.nc", NF90_NOWRITE, file_id)==nf90_noerr) THEN36 iret=nf90_close(file_id) 37 ELSE IF (nf90_open("land_water_0.05.nc", nf90_nowrite, file_id)==nf90_noerr) THEN 38 38 CALL xios_set_file_attr("land_water",name="land_water_0.05",enabled=.TRUE.) 39 39 CALL xios_set_field_attr("mask",field_ref="land_water") 40 iret= NF90_CLOSE(file_id)41 ELSE IF ( NF90_OPEN("land_water_0.25.nc", NF90_NOWRITE, file_id)==nf90_noerr) THEN40 iret=nf90_close(file_id) 41 ELSE IF (nf90_open("land_water_0.25.nc", nf90_nowrite, file_id)==nf90_noerr) THEN 42 42 CALL xios_set_file_attr("land_water",name="land_water_0.25",enabled=.TRUE.) 43 43 CALL xios_set_field_attr("mask",field_ref="land_water") 44 iret= NF90_CLOSE(file_id)45 ELSE IF ( NF90_OPEN("land_water_0.50.nc", NF90_NOWRITE, file_id)==nf90_noerr) THEN44 iret=nf90_close(file_id) 45 ELSE IF (nf90_open("land_water_0.50.nc", nf90_nowrite, file_id)==nf90_noerr) THEN 46 46 CALL xios_set_file_attr("land_water",name="land_water_0.50",enabled=.TRUE.) 47 47 CALL xios_set_field_attr("mask",field_ref="land_water") 48 iret= NF90_CLOSE(file_id)48 iret=nf90_close(file_id) 49 49 ENDIF 50 50 -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz1d.F90
r5099 r5100 2 2 ! $Id$ 3 3 4 !#ifdef CPP_1D5 4 !#include "../dyn3d/mod_const_mpi.F90" 6 5 !#include "../dyn3d_common/control_mod.F90" -
LMDZ6/branches/Amaury_dev/libf/phylmd/grid_noro_m.F90
r5099 r5100 435 435 ! Purpose: Read parameters usually determined with grid_noro from a file. 436 436 !=============================================================================== 437 USE netcdf, ONLY: NF90_OPEN, nf90_inq_dimid, nf90_inquire_dimension, &438 nf90_noerr, NF90_CLOSE, NF90_INQ_VARID, nf90_get_var, NF90_STRERROR, &439 NF90_NOWRITE437 USE netcdf, ONLY: nf90_open, nf90_inq_dimid, nf90_inquire_dimension, & 438 nf90_noerr, nf90_close, NF90_INQ_VARID, nf90_get_var, NF90_STRERROR, & 439 nf90_nowrite 440 440 IMPLICIT NONE 441 441 !------------------------------------------------------------------------------- … … 471 471 masque_lu=ANY(mask/=-99999.); IF(.NOT.masque_lu) mask=0.0 472 472 WRITE(lunout,*)'Masque lu: ',masque_lu 473 CALL ncerr( NF90_OPEN(fname,NF90_NOWRITE,fid))473 CALL ncerr(nf90_open(fname,nf90_nowrite,fid)) 474 474 CALL check_dim('x','longitude',x(1:imar)) 475 475 CALL check_dim('y','latitude' ,y(1:jmar)) … … 483 483 zpic=zmea+2*zstd 484 484 zval=MAX(0.,zmea-2.*zstd) 485 CALL ncerr( NF90_CLOSE(fid))485 CALL ncerr(nf90_close(fid)) 486 486 WRITE(lunout,*)' MEAN ORO:' ,MAXVAL(zmea) 487 487 WRITE(lunout,*)' ST. DEV.:' ,MAXVAL(zstd) -
LMDZ6/branches/Amaury_dev/libf/phylmd/iostart.F90
r5099 r5100 37 37 38 38 IF (is_mpi_root .AND. is_omp_root) THEN 39 ierr = NF90_OPEN (filename, NF90_NOWRITE,nid_start)39 ierr = nf90_open (filename, nf90_nowrite,nid_start) 40 40 IF (ierr/=nf90_noerr) THEN 41 41 write(6,*)' Pb d''ouverture du fichier '//filename … … 54 54 55 55 IF (is_mpi_root .AND. is_omp_root) THEN 56 ierr = NF90_CLOSE(nid_start)56 ierr = nf90_close (nid_start) 57 57 ENDIF 58 58 … … 312 312 313 313 IF (is_master) THEN 314 ierr = NF90_CREATE(filename, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &314 ierr = nf90_create(filename, IOR(nf90_clobber,nf90_64bit_offset), & 315 315 nid_restart) 316 316 IF (ierr/=nf90_noerr) THEN … … 320 320 ENDIF 321 321 322 ierr = NF90_PUT_ATT (nid_restart, NF90_GLOBAL, "title","Fichier redemmarage physique")323 324 ierr = NF90_DEF_DIM(nid_restart, "index", length, idim1)325 ierr = NF90_DEF_DIM(nid_restart, "points_physiques", klon_glo, idim2)326 ierr = NF90_DEF_DIM(nid_restart, "horizon_vertical", klon_glo*klev, idim3)327 ierr = NF90_DEF_DIM(nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4)328 329 ! ierr = NF90_ENDDEF(nid_restart)322 ierr = nf90_put_att (nid_restart, nf90_global, "title","Fichier redemmarage physique") 323 324 ierr = nf90_def_dim (nid_restart, "index", length, idim1) 325 ierr = nf90_def_dim (nid_restart, "points_physiques", klon_glo, idim2) 326 ierr = nf90_def_dim (nid_restart, "horizon_vertical", klon_glo*klev, idim3) 327 ierr = nf90_def_dim (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4) 328 329 ! ierr = nf90_enddef(nid_restart) 330 330 ENDIF 331 331 … … 338 338 INTEGER :: ierr 339 339 340 IF (is_master) ierr = NF90_ENDDEF(nid_restart)340 IF (is_master) ierr = nf90_enddef(nid_restart) 341 341 342 342 END SUBROUTINE enddef_restartphy … … 348 348 INTEGER :: ierr 349 349 350 IF (is_master) ierr = NF90_CLOSE(nid_restart)350 IF (is_master) ierr = nf90_close (nid_restart) 351 351 352 352 END SUBROUTINE close_restartphy … … 426 426 427 427 ! ierr = NF90_REDEF (nid_restart) 428 ierr = NF90_DEF_VAR(nid_restart, field_name, nf90_format,(/ idim /),nvarid)429 IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT(nid_restart,nvarid,"title", title)430 ! ierr = NF90_ENDDEF(nid_restart)428 ierr = nf90_def_var (nid_restart, field_name, nf90_format,(/ idim /),nvarid) 429 IF (LEN_TRIM(title) > 0) ierr = nf90_put_att (nid_restart,nvarid,"title", title) 430 ! ierr = nf90_enddef(nid_restart) 431 431 ENDIF 432 432 … … 454 454 455 455 ierr = NF90_INQ_VARID(nid_restart, field_name, nvarid) 456 ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))456 ierr = nf90_put_var(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/))) 457 457 ENDIF 458 458 ENDIF … … 536 536 ! ierr = NF90_REDEF (nid_restart) 537 537 538 ierr = NF90_DEF_VAR(nid_restart, var_name, nf90_format,(/ idim1 /),nvarid)539 IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT(nid_restart,nvarid,"title", title)540 ! ierr = NF90_ENDDEF(nid_restart)538 ierr = nf90_def_var (nid_restart, var_name, nf90_format,(/ idim1 /),nvarid) 539 IF (LEN_TRIM(title)>0) ierr = nf90_put_att (nid_restart,nvarid,"title", title) 540 ! ierr = nf90_enddef(nid_restart) 541 541 542 542 ! second pass : write 543 543 ELSE IF (pass==2) THEN 544 544 ierr = NF90_INQ_VARID(nid_restart, var_name, nvarid) 545 ierr = NF90_PUT_VAR(nid_restart,nvarid,var)545 ierr = nf90_put_var(nid_restart,nvarid,var) 546 546 ENDIF 547 547 ENDIF -
LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ecrit.F90
r5099 r5100 109 109 110 110 111 ierr= NF90_PUT_VAR(nid,varid,date,[ntime])111 ierr= nf90_put_var(nid,varid,date,[ntime]) 112 112 113 113 ! print*,'date ',date,ierr,nid … … 173 173 174 174 175 ierr= NF90_PUT_VAR(nid,varid,zx,corner,edges)175 ierr= nf90_put_var(nid,varid,zx,corner,edges) 176 176 177 177 if (ierr/=nf90_noerr) then -
LMDZ6/branches/Amaury_dev/libf/phylmd/limit_read_mod.F90
r5099 r5100 234 234 !$OMP MASTER ! Only master thread 235 235 IF (is_mpi_root) THEN ! Only master processus 236 ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)236 ierr = nf90_open ('limit.nc', nf90_nowrite, nid) 237 237 IF (ierr /= nf90_noerr) CALL abort_physic(modname,& 238 238 'Pb d''ouverture du fichier de conditions aux limites',1) … … 240 240 !--- WARNING IF CALENDAR IS KNOWN AND DOES NOT MATCH THE ONE OF LMDZ 241 241 ierr=NF90_INQ_VARID(nid, 'TEMPS', nvarid) 242 ierr= NF90_GET_ATT(nid, nvarid, 'calendar', calendar)242 ierr=nf90_get_att(nid, nvarid, 'calendar', calendar) 243 243 IF(ierr==nf90_noerr.AND.calendar/=calend.AND.prt_level>=1) THEN 244 244 WRITE(lunout,*)'BEWARE: gcm and limit.nc calendars differ: ' … … 269 269 IF(nn/=klon_glo) CALL abort_physic(modname,abort_message,1) 270 270 271 ierr = NF90_CLOSE(nid)271 ierr = nf90_close(nid) 272 272 IF (ierr /= nf90_noerr) CALL abort_physic(modname,'Pb when closing file', 1) 273 273 END IF ! is_mpi_root … … 332 332 IF (is_mpi_root) THEN ! Only master processus! 333 333 334 ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)334 ierr = nf90_open ('limit.nc', nf90_nowrite, nid) 335 335 IF (ierr /= nf90_noerr) CALL abort_physic(modname,& 336 336 'Pb d''ouverture du fichier de conditions aux limites',1) … … 426 426 427 427 !**************************************************************************************** 428 ierr = NF90_CLOSE(nid)428 ierr = nf90_close(nid) 429 429 IF (ierr /= nf90_noerr) CALL abort_physic(modname,'Pb when closing file', 1) 430 430 ENDIF ! is_mpi_root -
LMDZ6/branches/Amaury_dev/libf/phylmd/limit_slab.F90
r5099 r5100 61 61 read_siv=.TRUE. 62 62 63 ierr = NF90_OPEN ('limit_slab.nc', NF90_NOWRITE, nid)63 ierr = nf90_open ('limit_slab.nc', nf90_nowrite, nid) 64 64 IF (ierr /= nf90_noerr) THEN 65 65 PRINT *,'LIMIT_SLAB file not found' … … 145 145 146 146 !**************************************************************************************** 147 ierr = NF90_CLOSE(nid)147 ierr = nf90_close(nid) 148 148 IF (ierr /= nf90_noerr) CALL abort_physic(modname,'Pb when closing file', 1) 149 149 END IF ! Read File -
LMDZ6/branches/Amaury_dev/libf/phylmd/mo_simple_plumes.F90
r5099 r5100 88 88 IF (is_mpi_root.AND.is_omp_root) THEN 89 89 90 iret = nf90_open("MACv2.0-SP_v1.nc", NF90_NOWRITE, ncid)90 iret = nf90_open("MACv2.0-SP_v1.nc", nf90_nowrite, ncid) 91 91 IF (iret /= nf90_noerr) THEN 92 92 abort_message='NetCDF File not opened' -
LMDZ6/branches/Amaury_dev/libf/phylmd/open_climoz_m.F90
r5099 r5100 53 53 press_in_cen = press_in_cen * 100. 54 54 nlev = SIZE(press_in_cen) 55 CALL NF95_INQ_VARID(ncID, "time", varID)55 CALL nf95_inq_varid(ncID, "time", varID) 56 56 CALL NF95_GW_VAR(ncid, varid, time_in) 57 57 ntim = SIZE(time_in) -
LMDZ6/branches/Amaury_dev/libf/phylmd/read_map2D.F90
r5099 r5100 30 30 ! Read variable from file. Done by master process MPI and master thread OpenMP 31 31 IF (is_mpi_root .AND. is_omp_root) THEN 32 ierr = NF90_OPEN(trim(filename), NF90_NOWRITE, nid)32 ierr = nf90_open(trim(filename), nf90_nowrite, nid) 33 33 IF (ierr /= nf90_noerr) CALL write_err_mess('Problem in opening file') 34 34 … … 41 41 IF (ierr /= nf90_noerr) CALL write_err_mess('Problem in reading varaiable') 42 42 43 ierr = NF90_CLOSE(nid)43 ierr = nf90_close(nid) 44 44 IF (ierr /= nf90_noerr) CALL write_err_mess('Problem in closing file') 45 45 -
LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_mod.F90
r5099 r5100 200 200 IF (is_mpi_root) THEN 201 201 202 IF (nf90_open(TRIM(file_aerosol), NF90_NOWRITE, ncid) /= nf90_noerr) THEN203 CALL check_err( nf90_open(TRIM(file_so4), NF90_NOWRITE, ncid), "pb open "//trim(file_so4) )202 IF (nf90_open(TRIM(file_aerosol), nf90_nowrite, ncid) /= nf90_noerr) THEN 203 CALL check_err( nf90_open(TRIM(file_so4), nf90_nowrite, ncid), "pb open "//trim(file_so4) ) 204 204 ENDIF 205 205 … … 351 351 352 352 WRITE(lunout,*) 'reading variable ',TRIM(varname),' in file ', TRIM(fname) 353 CALL check_err( nf90_open(TRIM(fname), NF90_NOWRITE, ncid), "pb open "//trim(fname) )353 CALL check_err( nf90_open(TRIM(fname), nf90_nowrite, ncid), "pb open "//trim(fname) ) 354 354 355 355 -
LMDZ6/branches/Amaury_dev/libf/phylmd/regr_horiz_time_climoz_m.F90
r5099 r5100 1 1 MODULE regr_horiz_time_climoz_m 2 2 3 USE interpolation, ONLY: locate4 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured5 USE nrtype, ONLY: pi6 USE netcdf, ONLY: NF90_CLOBBER, NF90_FLOAT, NF90_OPEN,&7 NF90_NOWRITE, nf90_noerr, NF90_GET_ATT, NF90_GLOBAL8 USE netcdf95, ONLY : NF95_DEF_DIM, NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION,&9 NF95_DEF_VAR, NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, &10 NF95_OPEN, NF95_CREATE, NF95_GET_ATT, NF95_GW_VAR, nf95_get_var,&11 NF95_CLOSE, NF95_ENDDEF, NF95_PUT_ATT,NF95_PUT_VAR, NF95_COPY_ATT12 USE print_control_mod, ONLY : lunout3 USE interpolation, ONLY : locate 4 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured 5 USE nrtype, ONLY : pi 6 USE netcdf, ONLY : nf90_clobber, nf90_float, nf90_open, & 7 nf90_nowrite, nf90_noerr, nf90_get_att, nf90_global 8 USE netcdf95, ONLY : nf95_def_dim, nf95_inq_dimid, nf95_inquire_dimension, & 9 nf95_def_var, nf95_inq_varid, NF95_INQUIRE_VARIABLE, & 10 NF95_OPEN, NF95_CREATE, NF95_GET_ATT, NF95_GW_VAR, nf95_get_var, & 11 NF95_CLOSE, NF95_ENDDEF, NF95_PUT_ATT, NF95_PUT_VAR, NF95_COPY_ATT 12 USE print_control_mod, ONLY : lunout 13 13 USE dimphy 14 14 IMPLICIT NONE 15 15 PRIVATE 16 16 PUBLIC :: regr_horiz_time_climoz 17 REAL, PARAMETER :: deg2rad =pi/180.18 CHARACTER(LEN =13), PARAMETER :: vars_in(2)=['tro3 ','tro3_daylight']17 REAL, PARAMETER :: deg2rad = pi / 180. 18 CHARACTER(LEN = 13), PARAMETER :: vars_in(2) = ['tro3 ', 'tro3_daylight'] 19 19 20 20 INTEGER :: nlat_ou, nlon_ou 21 21 REAL, ALLOCATABLE :: latitude_glo(:) 22 !$OMP THREADPRIVATE(latitude_glo)22 !$OMP THREADPRIVATE(latitude_glo) 23 23 INTEGER, ALLOCATABLE :: ind_cell_glo_glo(:) 24 !$OMP THREADPRIVATE(ind_cell_glo_glo)24 !$OMP THREADPRIVATE(ind_cell_glo_glo) 25 25 26 26 CONTAINS 27 27 28 !------------------------------------------------------------------------------- 29 30 SUBROUTINE regr_horiz_time_climoz(read_climoz,interpt) 31 32 !------------------------------------------------------------------------------- 33 ! Purpose: Regrid horizontally and in time zonal or 3D ozone climatologies. 34 ! * Read ozone climatology from netcdf file 35 ! * Regrid it horizontaly to LMDZ grid (quasi-conservative method) 36 ! * If interpt=T, interpolate linearly in time (one record each day) 37 ! If interpt=F, keep original time sampling (14 months). 38 ! * Save it to a new netcdf file. 39 !------------------------------------------------------------------------------- 40 ! Remarks: 41 ! * Up to 2 variables treated: "tro3" and "tro3_daylight" (if read_climoz=2) 42 ! * Input fields coordinates: (longitudes, latitudes, pressure_levels, time) 43 ! * Output grid cells centers coordinates given by [rlonv,] rlatu. 44 ! * Output grid cells edges coordinates given by [rlonu,] rlatv. 45 ! * Input file [longitudes and] latitudes given in degrees. 46 ! * Input file pressure levels are given in Pa or hPa. 47 ! * All coordinates variables are stricly monotonic. 48 ! * Monthly fields are interpolated linearly in time to get daily values. 49 ! * Fields are known at the middle of the months, so interpolation requires an 50 ! additional record both for 1st half of january and 2nd half of december: 51 ! - For a 14-records "climoz.nc": records 1 and 14. 52 ! - For 12-records files: 53 ! record 12 of "climoz_m.nc" if available, or record 1 of "climoz.nc". 54 ! record 1 of "climoz_p.nc" if available, or record 12 of "climoz.nc". 55 ! * Calendar is taken into account to get one record each day (not 360 always). 56 ! * Missing values are filled in from sky to ground by copying lowest valid one. 57 ! Attribute "missing_value" or "_FillValue" must be present in input file. 58 !------------------------------------------------------------------------------- 59 USE assert_m, ONLY: assert 60 USE cal_tools_m, ONLY: year_len, mid_month 61 !! USE control_mod, ONLY: anneeref 62 USE time_phylmdz_mod, ONLY: annee_ref 63 USE ioipsl, ONLY: ioget_year_len, ioget_calendar 64 USE regr_conserv_m, ONLY: regr_conserv 65 USE regr_lint_m, ONLY: regr_lint 66 USE regular_lonlat_mod, ONLY: boundslon_reg, boundslat_reg, south, west, east 67 USE slopes_m, ONLY: slopes 68 USE lmdz_xios 69 USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_master, is_omp_master, gather, gather_mpi, bcast_mpi, klon_mpi 70 USE geometry_mod, ONLY : latitude_deg, ind_cell_glo 71 USE mod_grid_phy_lmdz, ONLY: klon_glo 72 73 !------------------------------------------------------------------------------- 74 ! Arguments: 75 INTEGER, INTENT(IN) :: read_climoz ! read ozone climatology, 1 or 2 76 ! 1: read a single ozone climatology used day and night 77 ! 2: same + read also a daylight climatology 78 LOGICAL, INTENT(IN) :: interpt ! TRUE => daily interpolation 79 ! FALSE => no interpolation (14 months) 80 !------------------------------------------------------------------------------- 81 ! Local variables: 82 83 !--- Input files variables 84 INTEGER :: nlon_in ! Number of longitudes 85 INTEGER :: nlat_in ! Number of latitudes 86 INTEGER :: nlev_in ! Number of pressure levels 87 INTEGER :: nmth_in ! Number of months 88 REAL, ALLOCATABLE:: lon_in(:) ! Longitudes (ascending order, rad) 89 REAL, ALLOCATABLE:: lat_in(:) ! Latitudes (ascending order, rad) 90 REAL, ALLOCATABLE:: lev_in(:) ! Pressure levels (ascen. order, hPa) 91 REAL, ALLOCATABLE :: lon_in_edge(:) ! Longitude intervals edges 92 ! (ascending order, / ) 93 REAL, ALLOCATABLE :: sinlat_in_edge(:) ! Sinus of latitude intervals edges 94 ! (ascending order, / ) 95 LOGICAL :: ldec_lon, ldec_lat, ldec_lev ! Decreasing order in input file 96 CHARACTER(LEN=20) :: cal_in ! Calendar 97 REAL, ALLOCATABLE :: o3_in3(:,:,:,:,:) ! Ozone climatologies 98 REAL, ALLOCATABLE :: o3_in3bis(:,:,:,:,:) ! Ozone climatologies 99 REAL, ALLOCATABLE :: o3_in2 (:,:,:,:) ! Ozone climatologies 100 REAL, ALLOCATABLE :: o3_in2bis(:,:,:,:,:) ! Ozone climatologies 101 ! last index: 1 for the day-night average, 2 for the daylight field. 102 REAL :: NaN 103 104 !--- Partially or totally regridded variables (:,:,nlev_in,:,read_climoz) 105 REAL, ALLOCATABLE :: o3_regr_lon (:,:,:,:,:) ! (nlon_ou,nlat_in,:,0:13 ,:) 106 REAL, ALLOCATABLE :: o3_regr_lonlat(:,:,:,:,:) ! (nlon_ou,nlat_ou,:,0:13 ,:) 107 REAL, ALLOCATABLE :: o3_out3 (:,:,:,:,:) ! (nlon_ou,nlat_ou,:,ntim_ou,:) 108 REAL, ALLOCATABLE :: o3_out3_glo (:,:,:,:) ! (nbp_lat,:,ntim_ou,:) 109 REAL, ALLOCATABLE :: o3_regr_lat (:,:,:,:) ! (nlat_in,:,0:13 ,:) 110 REAL, ALLOCATABLE :: o3_out2 (:,:,:,:) ! (nlat_ou,:,ntim_ou,:) 111 REAL, ALLOCATABLE :: o3_out2_glo (:,:,:,:) ! (nbp_lat,:,ntim_ou,:) 112 REAL, ALLOCATABLE :: o3_out (:,:,:,:) ! (nbp_lat,:,ntim_ou,:) 113 ! Dimension number | Interval | Contains | For variables: 114 ! 1 (longitude) | [rlonu(i-1), rlonu(i)] | rlonv(i) | all 115 ! 2 (latitude) | [rlatv(j), rlatv(j-1)] | rlatu(j) | all but o3_regr_lon 116 ! 3 (press level) | | lev(k) | all 117 ! Note that rlatv(0)=pi/2 and rlatv(nlat_ou)=-pi/2. 118 ! Dimension 4 is: month number (all vars but o3_out) 119 ! days elapsed since Jan. 1st 0h at mid-day (o3_out only) 120 REAL, ALLOCATABLE :: v1(:) 121 122 !--- For NetCDF: 123 INTEGER :: fID_in_m, fID_in, levID_ou, dimid, vID_in(read_climoz), ntim_ou 124 INTEGER :: fID_in_p, fID_ou, timID_ou, varid, vID_ou(read_climoz), ndims, ncerr 125 INTEGER, ALLOCATABLE :: dIDs(:) 126 CHARACTER(LEN=20) :: cal_ou !--- Calendar; no time inter => same as input 127 CHARACTER(LEN=80) :: press_unit !--- Pressure unit 128 REAL :: tmidmonth(0:13) !--- Elapsed days since Jan-1 0h at mid-months 129 ! Additional records 0, 13 for interpolation 130 REAL, ALLOCATABLE :: tmidday(:) !--- Output times (mid-days since Jan 1st 0h) 131 LOGICAL :: lprev, lnext !--- Flags: previous/next files are present 132 LOGICAL :: l3D, l2D !--- Flag: input fields are 3D or zonal 133 INTEGER :: ii, i, j, k, l, m, dln, ib, ie, iv, dx1, dx2 134 INTEGER, ALLOCATABLE :: sta(:), cnt(:) 135 CHARACTER(LEN=80) :: sub, dim_nam, msg 136 REAL :: null_array(0) 137 LOGICAL,SAVE :: first=.TRUE. 138 !$OMP THREADPRIVATE(first) 139 REAL, ALLOCATABLE :: test_o3_in(:,:) 140 REAL, ALLOCATABLE :: test_o3_out(:) 141 142 143 IF (grid_type==unstructured) THEN 144 IF (first) THEN 145 IF (is_master) THEN 146 ALLOCATE(latitude_glo(klon_glo)) 147 ALLOCATE(ind_cell_glo_glo(klon_glo)) 148 ELSE 149 ALLOCATE(latitude_glo(0)) 150 ALLOCATE(ind_cell_glo_glo(0)) 28 !------------------------------------------------------------------------------- 29 30 SUBROUTINE regr_horiz_time_climoz(read_climoz, interpt) 31 32 !------------------------------------------------------------------------------- 33 ! Purpose: Regrid horizontally and in time zonal or 3D ozone climatologies. 34 ! * Read ozone climatology from netcdf file 35 ! * Regrid it horizontaly to LMDZ grid (quasi-conservative method) 36 ! * If interpt=T, interpolate linearly in time (one record each day) 37 ! If interpt=F, keep original time sampling (14 months). 38 ! * Save it to a new netcdf file. 39 !------------------------------------------------------------------------------- 40 ! Remarks: 41 ! * Up to 2 variables treated: "tro3" and "tro3_daylight" (if read_climoz=2) 42 ! * Input fields coordinates: (longitudes, latitudes, pressure_levels, time) 43 ! * Output grid cells centers coordinates given by [rlonv,] rlatu. 44 ! * Output grid cells edges coordinates given by [rlonu,] rlatv. 45 ! * Input file [longitudes and] latitudes given in degrees. 46 ! * Input file pressure levels are given in Pa or hPa. 47 ! * All coordinates variables are stricly monotonic. 48 ! * Monthly fields are interpolated linearly in time to get daily values. 49 ! * Fields are known at the middle of the months, so interpolation requires an 50 ! additional record both for 1st half of january and 2nd half of december: 51 ! - For a 14-records "climoz.nc": records 1 and 14. 52 ! - For 12-records files: 53 ! record 12 of "climoz_m.nc" if available, or record 1 of "climoz.nc". 54 ! record 1 of "climoz_p.nc" if available, or record 12 of "climoz.nc". 55 ! * Calendar is taken into account to get one record each day (not 360 always). 56 ! * Missing values are filled in from sky to ground by copying lowest valid one. 57 ! Attribute "missing_value" or "_FillValue" must be present in input file. 58 !------------------------------------------------------------------------------- 59 USE assert_m, ONLY : assert 60 USE cal_tools_m, ONLY : year_len, mid_month 61 !! USE control_mod, ONLY: anneeref 62 USE time_phylmdz_mod, ONLY : annee_ref 63 USE ioipsl, ONLY : ioget_year_len, ioget_calendar 64 USE regr_conserv_m, ONLY : regr_conserv 65 USE regr_lint_m, ONLY : regr_lint 66 USE regular_lonlat_mod, ONLY : boundslon_reg, boundslat_reg, south, west, east 67 USE slopes_m, ONLY : slopes 68 USE lmdz_xios 69 USE mod_phys_lmdz_para, ONLY : is_mpi_root, is_master, is_omp_master, gather, gather_mpi, bcast_mpi, klon_mpi 70 USE geometry_mod, ONLY : latitude_deg, ind_cell_glo 71 USE mod_grid_phy_lmdz, ONLY : klon_glo 72 73 !------------------------------------------------------------------------------- 74 ! Arguments: 75 INTEGER, INTENT(IN) :: read_climoz ! read ozone climatology, 1 or 2 76 ! 1: read a single ozone climatology used day and night 77 ! 2: same + read also a daylight climatology 78 LOGICAL, INTENT(IN) :: interpt ! TRUE => daily interpolation 79 ! FALSE => no interpolation (14 months) 80 !------------------------------------------------------------------------------- 81 ! Local variables: 82 83 !--- Input files variables 84 INTEGER :: nlon_in ! Number of longitudes 85 INTEGER :: nlat_in ! Number of latitudes 86 INTEGER :: nlev_in ! Number of pressure levels 87 INTEGER :: nmth_in ! Number of months 88 REAL, ALLOCATABLE :: lon_in(:) ! Longitudes (ascending order, rad) 89 REAL, ALLOCATABLE :: lat_in(:) ! Latitudes (ascending order, rad) 90 REAL, ALLOCATABLE :: lev_in(:) ! Pressure levels (ascen. order, hPa) 91 REAL, ALLOCATABLE :: lon_in_edge(:) ! Longitude intervals edges 92 ! (ascending order, / ) 93 REAL, ALLOCATABLE :: sinlat_in_edge(:) ! Sinus of latitude intervals edges 94 ! (ascending order, / ) 95 LOGICAL :: ldec_lon, ldec_lat, ldec_lev ! Decreasing order in input file 96 CHARACTER(LEN = 20) :: cal_in ! Calendar 97 REAL, ALLOCATABLE :: o3_in3(:, :, :, :, :) ! Ozone climatologies 98 REAL, ALLOCATABLE :: o3_in3bis(:, :, :, :, :) ! Ozone climatologies 99 REAL, ALLOCATABLE :: o3_in2 (:, :, :, :) ! Ozone climatologies 100 REAL, ALLOCATABLE :: o3_in2bis(:, :, :, :, :) ! Ozone climatologies 101 ! last index: 1 for the day-night average, 2 for the daylight field. 102 REAL :: NaN 103 104 !--- Partially or totally regridded variables (:,:,nlev_in,:,read_climoz) 105 REAL, ALLOCATABLE :: o3_regr_lon (:, :, :, :, :) ! (nlon_ou,nlat_in,:,0:13 ,:) 106 REAL, ALLOCATABLE :: o3_regr_lonlat(:, :, :, :, :) ! (nlon_ou,nlat_ou,:,0:13 ,:) 107 REAL, ALLOCATABLE :: o3_out3 (:, :, :, :, :) ! (nlon_ou,nlat_ou,:,ntim_ou,:) 108 REAL, ALLOCATABLE :: o3_out3_glo (:, :, :, :) ! (nbp_lat,:,ntim_ou,:) 109 REAL, ALLOCATABLE :: o3_regr_lat (:, :, :, :) ! (nlat_in,:,0:13 ,:) 110 REAL, ALLOCATABLE :: o3_out2 (:, :, :, :) ! (nlat_ou,:,ntim_ou,:) 111 REAL, ALLOCATABLE :: o3_out2_glo (:, :, :, :) ! (nbp_lat,:,ntim_ou,:) 112 REAL, ALLOCATABLE :: o3_out (:, :, :, :) ! (nbp_lat,:,ntim_ou,:) 113 ! Dimension number | Interval | Contains | For variables: 114 ! 1 (longitude) | [rlonu(i-1), rlonu(i)] | rlonv(i) | all 115 ! 2 (latitude) | [rlatv(j), rlatv(j-1)] | rlatu(j) | all but o3_regr_lon 116 ! 3 (press level) | | lev(k) | all 117 ! Note that rlatv(0)=pi/2 and rlatv(nlat_ou)=-pi/2. 118 ! Dimension 4 is: month number (all vars but o3_out) 119 ! days elapsed since Jan. 1st 0h at mid-day (o3_out only) 120 REAL, ALLOCATABLE :: v1(:) 121 122 !--- For NetCDF: 123 INTEGER :: fID_in_m, fID_in, levID_ou, dimid, vID_in(read_climoz), ntim_ou 124 INTEGER :: fID_in_p, fID_ou, timID_ou, varid, vID_ou(read_climoz), ndims, ncerr 125 INTEGER, ALLOCATABLE :: dIDs(:) 126 CHARACTER(LEN = 20) :: cal_ou !--- Calendar; no time inter => same as input 127 CHARACTER(LEN = 80) :: press_unit !--- Pressure unit 128 REAL :: tmidmonth(0:13) !--- Elapsed days since Jan-1 0h at mid-months 129 ! Additional records 0, 13 for interpolation 130 REAL, ALLOCATABLE :: tmidday(:) !--- Output times (mid-days since Jan 1st 0h) 131 LOGICAL :: lprev, lnext !--- Flags: previous/next files are present 132 LOGICAL :: l3D, l2D !--- Flag: input fields are 3D or zonal 133 INTEGER :: ii, i, j, k, l, m, dln, ib, ie, iv, dx1, dx2 134 INTEGER, ALLOCATABLE :: sta(:), cnt(:) 135 CHARACTER(LEN = 80) :: sub, dim_nam, msg 136 REAL :: null_array(0) 137 LOGICAL, SAVE :: first = .TRUE. 138 !$OMP THREADPRIVATE(first) 139 REAL, ALLOCATABLE :: test_o3_in(:, :) 140 REAL, ALLOCATABLE :: test_o3_out(:) 141 142 IF (grid_type==unstructured) THEN 143 IF (first) THEN 144 IF (is_master) THEN 145 ALLOCATE(latitude_glo(klon_glo)) 146 ALLOCATE(ind_cell_glo_glo(klon_glo)) 147 ELSE 148 ALLOCATE(latitude_glo(0)) 149 ALLOCATE(ind_cell_glo_glo(0)) 150 ENDIF 151 CALL gather(latitude_deg, latitude_glo) 152 CALL gather(ind_cell_glo, ind_cell_glo_glo) 151 153 ENDIF 152 CALL gather(latitude_deg, latitude_glo) 153 CALL gather(ind_cell_glo, ind_cell_glo_glo) 154 ENDIF 155 ENDIF 156 157 IF (is_omp_master) THEN 158 nlat_ou=nbp_lat 159 nlon_ou=nbp_lon 160 161 !------------------------------------------------------------------------------- 162 IF (is_mpi_root) THEN 163 sub="regr_horiz_time_climoz" 164 WRITE(lunout,*)"Call sequence information: "//TRIM(sub) 165 CALL assert(read_climoz == 1 .OR. read_climoz == 2, "regr_lat_time_climoz") 166 167 CALL NF95_OPEN("climoz.nc" , NF90_NOWRITE, fID_in) 168 lprev=NF90_OPEN("climoz_m.nc", NF90_NOWRITE, fID_in_m)==nf90_noerr 169 lnext=NF90_OPEN("climoz_p.nc", NF90_NOWRITE, fID_in_p)==nf90_noerr 170 171 !--- Get coordinates from the input file. Converts lon/lat in radians. 172 ! Few inversions because "regr_conserv" and gcm need ascending vectors. 173 CALL NF95_INQ_VARID(fID_in, vars_in(1), varid) 174 CALL NF95_INQUIRE_VARIABLE(fID_in, varid, dimids=dIDs, ndims=ndims) 175 l3D=ndims==4; l2D=ndims==3 176 IF(l3D) WRITE(lunout,*)"Input files contain full 3D ozone fields." 177 IF(l2D) WRITE(lunout,*)"Input files contain zonal 2D ozone fields." 178 DO i=1,ndims 179 CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), name=dim_nam, nclen=dln) 180 CALL NF95_INQ_VARID(fID_in, dim_nam, varid) 181 ii=i; IF(l2D) ii=i+1 !--- ndims==3:NO LONGITUDE 182 SELECT CASE(ii) 154 ENDIF 155 156 IF (is_omp_master) THEN 157 nlat_ou = nbp_lat 158 nlon_ou = nbp_lon 159 160 !------------------------------------------------------------------------------- 161 IF (is_mpi_root) THEN 162 sub = "regr_horiz_time_climoz" 163 WRITE(lunout, *)"Call sequence information: " // TRIM(sub) 164 CALL assert(read_climoz == 1 .OR. read_climoz == 2, "regr_lat_time_climoz") 165 166 CALL NF95_OPEN("climoz.nc", nf90_nowrite, fID_in) 167 lprev = nf90_open("climoz_m.nc", nf90_nowrite, fID_in_m)==nf90_noerr 168 lnext = nf90_open("climoz_p.nc", nf90_nowrite, fID_in_p)==nf90_noerr 169 170 !--- Get coordinates from the input file. Converts lon/lat in radians. 171 ! Few inversions because "regr_conserv" and gcm need ascending vectors. 172 CALL nf95_inq_varid(fID_in, vars_in(1), varid) 173 CALL NF95_INQUIRE_VARIABLE(fID_in, varid, dimids = dIDs, ndims = ndims) 174 l3D = ndims==4; l2D = ndims==3 175 IF(l3D) WRITE(lunout, *)"Input files contain full 3D ozone fields." 176 IF(l2D) WRITE(lunout, *)"Input files contain zonal 2D ozone fields." 177 DO i = 1, ndims 178 CALL nf95_inquire_dimension(fID_in, dIDs(i), name = dim_nam, nclen = dln) 179 CALL nf95_inq_varid(fID_in, dim_nam, varid) 180 ii = i; IF(l2D) ii = i + 1 !--- ndims==3:NO LONGITUDE 181 SELECT CASE(ii) 183 182 CASE(1) !--- LONGITUDE 184 183 CALL NF95_GW_VAR(fID_in, varid, lon_in) 185 ldec_lon =lon_in(1)>lon_in(dln); IF(ldec_lon) lon_in=lon_in(dln:1:-1)186 nlon_in =dln; lon_in=lon_in*deg2rad184 ldec_lon = lon_in(1)>lon_in(dln); IF(ldec_lon) lon_in = lon_in(dln:1:-1) 185 nlon_in = dln; lon_in = lon_in * deg2rad 187 186 CASE(2) !--- LATITUDE 188 187 CALL NF95_GW_VAR(fID_in, varid, lat_in) 189 ldec_lat =lat_in(1)>lat_in(dln); IF(ldec_lat) lat_in=lat_in(dln:1:-1)190 nlat_in =dln; lat_in=lat_in*deg2rad188 ldec_lat = lat_in(1)>lat_in(dln); IF(ldec_lat) lat_in = lat_in(dln:1:-1) 189 nlat_in = dln; lat_in = lat_in * deg2rad 191 190 CASE(3) !--- PRESSURE LEVELS 192 191 CALL NF95_GW_VAR(fID_in, varid, lev_in) 193 ldec_lev =lev_in(1)>lev_in(dln); IF(ldec_lev) lev_in=lev_in(dln:1:-1)194 nlev_in =dln192 ldec_lev = lev_in(1)>lev_in(dln); IF(ldec_lev) lev_in = lev_in(dln:1:-1) 193 nlev_in = dln 195 194 CALL NF95_GET_ATT(fID_in, varid, "units", press_unit) 196 k =LEN_TRIM(press_unit)195 k = LEN_TRIM(press_unit) 197 196 DO WHILE(ICHAR(press_unit(k:k))==0) 198 press_unit(k:k) =' '; k=LEN_TRIM(press_unit) !--- REMOVE NULL END CHAR197 press_unit(k:k) = ' '; k = LEN_TRIM(press_unit) !--- REMOVE NULL END CHAR 199 198 END DO 200 199 IF(press_unit == "Pa") THEN 201 lev_in = lev_in /100. !--- CONVERT TO hPa200 lev_in = lev_in / 100. !--- CONVERT TO hPa 202 201 ELSE IF(press_unit /= "hPa") THEN 203 CALL abort_physic(sub, "the only recognized units are Pa and hPa.", 1)202 CALL abort_physic(sub, "the only recognized units are Pa and hPa.", 1) 204 203 END IF 205 204 CASE(4) !--- TIME 206 CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), nclen=nmth_in)207 cal_in ='gregorian'208 IF( NF90_GET_ATT(fID_in, varid, 'calendar', cal_in)/=nf90_noerr) &209 WRITE(lunout,*)'WARNING: missing "calendar" attribute for "'//&210 TRIM(dim_nam)//'" in "climoz.nc". Choosing default: "gregorian".'211 k =LEN_TRIM(cal_in)205 CALL nf95_inquire_dimension(fID_in, dIDs(i), nclen = nmth_in) 206 cal_in = 'gregorian' 207 IF(nf90_get_att(fID_in, varid, 'calendar', cal_in)/=nf90_noerr) & 208 WRITE(lunout, *)'WARNING: missing "calendar" attribute for "' // & 209 TRIM(dim_nam) // '" in "climoz.nc". Choosing default: "gregorian".' 210 k = LEN_TRIM(cal_in) 212 211 DO WHILE(ICHAR(cal_in(k:k))==0) 213 cal_in(k:k)=' '; k=LEN_TRIM(cal_in) !--- REMOVE NULL END CHAR 214 END DO 215 END SELECT 216 END DO 217 218 !--- Prepare quantities for time interpolation 219 tmidmonth=mid_month(annee_ref, cal_in) 220 IF(interpt) THEN 221 ntim_ou=ioget_year_len(annee_ref) 222 ALLOCATE(tmidday(ntim_ou)) 223 tmidday=[(REAL(k)-0.5,k=1,ntim_ou)] 224 CALL ioget_calendar(cal_ou) 212 cal_in(k:k) = ' '; k = LEN_TRIM(cal_in) !--- REMOVE NULL END CHAR 213 END DO 214 END SELECT 215 END DO 216 217 !--- Prepare quantities for time interpolation 218 tmidmonth = mid_month(annee_ref, cal_in) 219 IF(interpt) THEN 220 ntim_ou = ioget_year_len(annee_ref) 221 ALLOCATE(tmidday(ntim_ou)) 222 tmidday = [(REAL(k) - 0.5, k = 1, ntim_ou)] 223 CALL ioget_calendar(cal_ou) 224 ELSE 225 ntim_ou = 14 226 cal_ou = cal_in 227 END IF 228 ENDIF 229 230 IF (grid_type==unstructured) THEN 231 CALL bcast_mpi(nlon_in) 232 CALL bcast_mpi(nlat_in) 233 CALL bcast_mpi(nlev_in) 234 CALL bcast_mpi(l3d) 235 CALL bcast_mpi(tmidmonth) 236 IF(interpt) CALL bcast_mpi(tmidday) 237 CALL bcast_mpi(ntim_ou) 238 239 IF (is_mpi_root) THEN 240 CALL xios_set_domain_attr("domain_climoz", nj_glo = nlat_in, nj = nlat_in, jbegin = 0, latvalue_1d = lat_in / deg2rad) 241 IF (l3D) THEN 242 CALL xios_set_domain_attr("domain_climoz", ni_glo = nlon_in, ni = nlon_in, ibegin = 0, lonvalue_1d = lon_in / deg2rad) 243 ELSE 244 CALL xios_set_domain_attr("domain_climoz", ni_glo = 8, ni = 8, ibegin = 0, lonvalue_1d = (/ 0., 45., 90., 135., 180., 225., 270., 315. /)) 245 ENDIF 246 ELSE 247 CALL xios_set_domain_attr("domain_climoz", nj_glo = nlat_in, nj = 0, jbegin = 0, latvalue_1d = null_array) 248 IF (l3D) THEN 249 CALL xios_set_domain_attr("domain_climoz", ni_glo = nlon_in, ni = 0, ibegin = 0, lonvalue_1d = null_array) 250 ELSE 251 CALL xios_set_domain_attr("domain_climoz", ni_glo = 8, ni = 0, ibegin = 0, lonvalue_1d = null_array) 252 ENDIF 253 ENDIF 254 CALL xios_set_axis_attr("axis_climoz", n_glo = nlev_in) 255 CALL xios_set_axis_attr("time_axis_climoz", n_glo = ntim_ou) 256 CALL xios_set_axis_attr("time_axis_climoz", n_glo = ntim_ou) 257 CALL xios_set_axis_attr("tr_climoz", n_glo = read_climoz) 258 CALL xios_set_field_attr("tro3_out", enabled = .TRUE.) 259 CALL xios_set_field_attr("tro3_out", enabled = .TRUE.) 260 261 IF (first) THEN 262 first = .FALSE. 263 RETURN 264 ENDIF 265 ENDIF 266 267 IF (is_mpi_root) THEN 268 !--- Longitudes management: 269 ! * Need to shift data if the origin of input file longitudes /= -pi 270 ! * Need to add some margin in longitude to ensure input interval contains 271 ! all the output intervals => at least one longitudes slice has to be 272 ! duplicated, possibly more for undersampling. 273 IF(l3D) THEN 274 IF (grid_type==unstructured) THEN 275 dx2 = 0 276 ELSE 277 !--- Compute input edges longitudes vector (no end point yet) 278 ALLOCATE(v1(nlon_in + 1)) 279 v1(1) = (lon_in(nlon_in) + lon_in(1)) / 2. - pi 280 FORALL(i = 2:nlon_in) v1(i) = (lon_in(i - 1) + lon_in(i)) / 2. 281 v1(nlon_in + 1) = v1(1) + 2. * pi 282 DEALLOCATE(lon_in) 283 284 !--- Shift input longitudes vector until it contains first output point boundslon_reg(1,west) 285 v1 = v1 + 2 * pi * REAL(FLOOR((boundslon_reg(1, west) - v1(1)) / (2. * pi))) 286 287 !--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west) 288 dx1 = locate(v1, boundslon_reg(1, west)) - 1 289 v1 = CSHIFT(v1, SHIFT = dx1, DIM = 1) 290 v1(nlon_in - dx1 + 2:) = v1(nlon_in - dx1 + 2:) + 2. * pi 291 292 !--- Extend input longitudes vector until last interval contains boundslon_reg(nlat_ou,east) 293 dx2 = 0; DO WHILE(v1(1 + dx2) + 2. * pi<=boundslon_reg(nlon_ou, east)); dx2 = dx2 + 1; 294 END DO 295 296 !--- Final edges longitudes vector (with margin and end point) 297 ALLOCATE(lon_in_edge(nlon_in + dx2 + 1)); lon_in_edge = [v1, v1(2:1 + dx2) + 2. * pi] 298 DEALLOCATE(v1) 299 ENDIF 300 END IF 301 302 !--- Compute sinus of intervals edges latitudes: 303 ALLOCATE(sinlat_in_edge(nlat_in + 1)) 304 sinlat_in_edge(1) = -1. ; sinlat_in_edge(nlat_in + 1) = 1. 305 FORALL(j = 2:nlat_in) sinlat_in_edge(j) = SIN((lat_in(j - 1) + lat_in(j)) / 2.) 306 DEALLOCATE(lat_in) 307 308 309 310 !--- Check for contiguous years: 311 ib = 0; ie = 13 312 IF(nmth_in == 14) THEN; lprev = .FALSE.; lnext = .FALSE. 313 WRITE(lunout, *)'Using 14 months ozone climatology "climoz.nc"...' 314 ELSE 315 IF(lprev) WRITE(lunout, *)'Using "climoz_m.nc" last record (previous year).' 316 IF(.NOT.lprev) WRITE(lunout, *)"No previous year file ; assuming periodicity." 317 IF(lnext) WRITE(lunout, *)'Using "climoz_p.nc" first record (next year).' 318 IF(.NOT.lnext) WRITE(lunout, *)"No next year file ; assuming periodicity." 319 IF(.NOT.lprev) ib = 1 320 IF(.NOT.lnext) ie = 12 321 END IF 322 ALLOCATE(sta(ndims), cnt(ndims)); sta(:) = 1 323 IF(l3D) cnt = [nlon_in, nlat_in, nlev_in, 1] 324 IF(l2D) cnt = [ nlat_in, nlev_in, 1] 325 IF(l3D) ALLOCATE(o3_in3(nlon_in + dx2, nlat_in, nlev_in, ib:ie, read_climoz)) 326 IF(l2D) ALLOCATE(o3_in2(nlat_in, nlev_in, ib:ie, read_climoz)) 327 328 !--- Read full current file and one record each available contiguous file 329 DO iv = 1, read_climoz 330 CALL nf95_inq_varid(fID_in, vars_in(1), vID_in(iv)) 331 IF(l3D) call NF95_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in, :, :, 1:12, iv)) 332 IF(l2D) call NF95_GET_VAR(fID_in, vID_in(iv), o3_in2(:, :, 1:12, iv)) 333 IF(lprev) THEN; sta(ndims) = 12 334 CALL nf95_inq_varid(fID_in_m, vars_in(1), vID_in(iv)) 335 IF(l3D) call NF95_GET_VAR(fID_in_m, vID_in(iv), o3_in3(1:nlon_in, :, :, 0, iv), sta, cnt) 336 IF(l2d) call NF95_GET_VAR(fID_in_m, vID_in(iv), o3_in2(:, :, 0, iv), sta, cnt) 337 END IF 338 IF(lnext) THEN; sta(ndims) = 1 339 CALL nf95_inq_varid(fID_in_p, vars_in(1), vID_in(iv)) 340 IF(l3D) call NF95_GET_VAR(fID_in_p, vID_in(iv), o3_in3(1:nlon_in, :, :, 13, iv), sta, cnt) 341 IF(l2D) call NF95_GET_VAR(fID_in_p, vID_in(iv), o3_in2(:, :, 13, iv), sta, cnt) 342 END IF 343 END DO 344 IF(lprev.OR.lnext) DEALLOCATE(sta, cnt) 345 IF(lprev) CALL NF95_CLOSE(fID_in_m) 346 IF(lnext) CALL NF95_CLOSE(fID_in_p) 347 348 !--- Revert decreasing coordinates vector 349 IF(l3D) THEN 350 IF(ldec_lon) o3_in3(1:nlon_in, :, :, :, :) = o3_in3(nlon_in:1:-1, :, :, :, :) 351 IF(ldec_lat) o3_in3 = o3_in3(:, nlat_in:1:-1, :, :, :) 352 IF(ldec_lev) o3_in3 = o3_in3(:, :, nlev_in:1:-1, :, :) 353 354 IF (grid_type /= unstructured) THEN 355 !--- Shift values for longitude and duplicate some longitudes slices 356 o3_in3(1:nlon_in, :, :, :, :) = CSHIFT(o3_in3(1:nlon_in, :, :, :, :), SHIFT = dx1, DIM = 1) 357 o3_in3(nlon_in + 1:nlon_in + dx2, :, :, :, :) = o3_in3(1:dx2, :, :, :, :) 358 ENDIF 359 ELSE 360 IF(ldec_lat) o3_in2 = o3_in2(nlat_in:1:-1, :, :, :) 361 IF(ldec_lev) o3_in2 = o3_in2(:, nlev_in:1:-1, :, :) 362 END IF 363 364 !--- Deal with missing values 365 DO m = 1, read_climoz 366 WRITE(msg, '(a,i0)')"regr_lat_time_climoz: field Nr.", m 367 IF(nf90_get_att(fID_in, vID_in(m), "missing_value", NaN)/= nf90_noerr) THEN 368 IF(nf90_get_att(fID_in, vID_in(m), "_FillValue", NaN)/= nf90_noerr) THEN 369 WRITE(lunout, *)TRIM(msg) // ": no missing value attribute found."; CYCLE 370 END IF 371 END IF 372 WRITE(lunout, *)TRIM(msg) // ": missing value attribute found." 373 WRITE(lunout, *)"Trying to fill in NaNs ; a full field would be better." 374 375 !--- Check top layer contains no NaNs & search NaNs from top to ground 376 msg = TRIM(sub) // ": NaNs in top layer !" 377 IF(l3D) THEN 378 IF(ANY(o3_in3(:, :, 1, :, m)==NaN)) CALL abort_physic(sub, msg, 1) 379 DO k = 2, nlev_in 380 WHERE(o3_in3(:, :, k, :, m)==NaN) o3_in3(:, :, k, :, m) = o3_in3(:, :, k - 1, :, m) 381 END DO 382 ELSE 383 IF(ANY(o3_in2(:, 1, :, m)==NaN)) THEN 384 WRITE(lunout, *)msg 385 !--- Fill in latitudes where all values are missing 386 DO l = 1, nmth_in 387 !--- Next to south pole 388 j = 1; DO WHILE(o3_in2(j, 1, l, m)==NaN); j = j + 1; 389 END DO 390 IF(j>1) & 391 o3_in2(:j - 1, :, l, m) = SPREAD(o3_in2(j, :, l, m), DIM = 1, ncopies = j - 1) 392 !--- Next to north pole 393 j = nlat_in; DO WHILE(o3_in2(j, 1, l, m)==NaN); j = j + 1; 394 END DO 395 IF(j<nlat_in) & 396 o3_in2(j + 1:, :, l, m) = SPREAD(o3_in2(j, :, l, m), DIM = 1, ncopies = nlat_in - j) 397 END DO 398 END IF 399 400 !--- Fill in high latitudes missing values 401 !--- Highest level been filled-in, so has always valid values. 402 DO k = 2, nlev_in 403 WHERE(o3_in2(:, k, :, m)==NaN) o3_in2(:, k, :, m) = o3_in2(:, k - 1, :, m) 404 END DO 405 END IF 406 END DO 407 408 ENDIF 409 410 !============================================================================= 411 IF(l3D) THEN !=== 3D FIELDS 412 !============================================================================= 413 IF (grid_type==unstructured) THEN 414 nlat_ou = klon_mpi 415 416 IF (is_mpi_root) THEN 417 ALLOCATE(o3_in3bis(nlon_in, nlat_in, nlev_in, 0:13, read_climoz)) 418 o3_in3bis(:, :, :, ib:ie, :) = o3_in3(1:nlon_in, :, :, ib:ie, :) 419 ELSE 420 ALLOCATE(o3_in3bis(0, 0, 0, 0, read_climoz)) 421 ENDIF 422 ALLOCATE(o3_regr_lonlat(1, nlat_ou, nlev_in, 0:13, read_climoz)) 423 424 CALL xios_send_field("tro3_in", o3_in3bis(:, :, :, :, :)) 425 CALL xios_recv_field("tro3_out", o3_regr_lonlat(1, :, :, :, :)) 426 ELSE 427 428 !--- Regrid in longitude 429 ALLOCATE(o3_regr_lon(nlon_ou, nlat_in, nlev_in, ie - ib + 1, read_climoz)) 430 CALL regr_conserv(1, o3_in3, xs = lon_in_edge, & 431 xt = [boundslon_reg(1, west), boundslon_reg(:, east)], & 432 vt = o3_regr_lon, slope = slopes(1, o3_in3, lon_in_edge)) 433 DEALLOCATE(o3_in3) 434 435 !--- Regrid in latitude: averaging with respect to SIN(lat) is 436 ! equivalent to weighting by COS(lat) 437 !--- (inverted indices in "o3_regr_lonlat" because "rlatu" is decreasing) 438 ALLOCATE(o3_regr_lonlat(nlon_ou, nlat_ou, nlev_in, 0:13, read_climoz)) 439 CALL regr_conserv(2, o3_regr_lon, xs = sinlat_in_edge, & 440 xt = [- 1., SIN(boundslat_reg(nlat_ou - 1:1:-1, south)), 1.], & 441 vt = o3_regr_lonlat(:, nlat_ou:1:- 1, :, ib:ie, :), & 442 slope = slopes(2, o3_regr_lon, sinlat_in_edge)) 443 DEALLOCATE(o3_regr_lon) 444 445 ENDIF 446 447 !--- Duplicate previous/next record(s) if they are not available 448 IF(.NOT.lprev) o3_regr_lonlat(:, :, :, 0, :) = o3_regr_lonlat(:, :, :, 12, :) 449 IF(.NOT.lnext) o3_regr_lonlat(:, :, :, 13, :) = o3_regr_lonlat(:, :, :, 1, :) 450 451 !--- Regrid in time by linear interpolation: 452 ALLOCATE(o3_out3(nlon_ou, nlat_ou, nlev_in, ntim_ou, read_climoz)) 453 IF(interpt) CALL regr_lint(4, o3_regr_lonlat, tmidmonth, tmidday, o3_out3) 454 IF(.NOT.interpt) o3_out3 = o3_regr_lonlat 455 DEALLOCATE(o3_regr_lonlat) 456 457 nlat_ou = nbp_lat 458 IF (grid_type==unstructured) THEN 459 CALL xios_send_field('o3_out', o3_out3) 460 ndims = 3 461 ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 462 CALL gather_mpi(o3_out3(1, :, :, :, :), o3_out3_glo) 463 ENDIF 464 465 !--- Create the output file and get the variable IDs: 466 CALL prepare_out(fID_in, nlev_in, ntim_ou, fID_ou, levID_ou, timID_ou, vID_ou, & 467 ndims, cal_ou) 468 469 IF (is_mpi_root) THEN 470 !--- Write remaining coordinate variables: 471 CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in) 472 IF(interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday) 473 IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth) 474 475 !--- Write to file (the order of "rlatu" is inverted in the output file): 476 IF (grid_type==unstructured) THEN 477 478 ALLOCATE(o3_out(nlat_ou, nlev_in, ntim_ou, read_climoz)) 479 DO i = 1, klon_glo 480 o3_out(ind_cell_glo_glo(i), :, :, :) = o3_out3_glo(i, :, :, :) 481 ENDDO 482 483 DO m = 1, read_climoz 484 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1, :, :, m)) 485 END DO 486 487 ELSE 488 DO m = 1, read_climoz 489 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out3(:, nlat_ou:1:-1, :, :, m)) 490 END DO 491 ENDIF 492 CALL NF95_CLOSE(fID_ou) 493 494 ENDIF 495 496 497 !============================================================================= 498 ELSE !=== ZONAL FIELDS 499 !============================================================================= 500 501 IF (grid_type==unstructured) THEN 502 nlat_ou = klon_mpi 503 504 IF (is_mpi_root) THEN 505 ALLOCATE(o3_in2bis(8, nlat_in, nlev_in, 0:13, read_climoz)) 506 o3_in2bis(:, :, :, ib:ie, :) = SPREAD(o3_in2, 1, 8) 507 ELSE 508 ALLOCATE(o3_in2bis(0, 0, 0, 0, read_climoz)) 509 ENDIF 510 ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz)) 511 CALL xios_send_field("tro3_in", o3_in2bis(:, :, :, :, :)) 512 CALL xios_recv_field("tro3_out", o3_regr_lat(:, :, :, :)) 513 IF(.NOT.lprev) o3_regr_lat(:, :, 0, :) = o3_regr_lat(:, :, 12, :) 514 IF(.NOT.lnext) o3_regr_lat(:, :, 13, :) = o3_regr_lat(:, :, 1, :) 515 516 ELSE 517 !--- Regrid in latitude: averaging with respect to SIN(lat) is 518 ! equivalent to weighting by COS(lat) 519 !--- (inverted indices in "o3_regr_lat" because "rlatu" is decreasing) 520 ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz)) 521 CALL regr_conserv(1, o3_in2, xs = sinlat_in_edge, & 522 xt = [- 1., SIN(boundslat_reg(nlat_ou - 1:1:-1, south)), 1.], & 523 vt = o3_regr_lat(nlat_ou:1:- 1, :, ib:ie, :), & 524 slope = slopes(1, o3_in2, sinlat_in_edge)) 525 DEALLOCATE(o3_in2) 526 527 !--- Duplicate previous/next record(s) if they are not available 528 IF(.NOT.lprev) o3_regr_lat(:, :, 0, :) = o3_regr_lat(:, :, 12, :) 529 IF(.NOT.lnext) o3_regr_lat(:, :, 13, :) = o3_regr_lat(:, :, 1, :) 530 531 ENDIF 532 533 !--- Regrid in time by linear interpolation: 534 ALLOCATE(o3_out2(nlat_ou, nlev_in, ntim_ou, read_climoz)) 535 IF(interpt) CALL regr_lint(3, o3_regr_lat, tmidmonth, tmidday, o3_out2) 536 IF(.NOT.interpt) o3_out2 = o3_regr_lat 537 DEALLOCATE(o3_regr_lat) 538 539 nlat_ou = nbp_lat 540 541 IF (grid_type==unstructured) THEN 542 ndims = 3 543 ALLOCATE(o3_out2_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 544 CALL gather_mpi(o3_out2, o3_out2_glo) 545 ENDIF 546 547 !--- Create the output file and get the variable IDs: 548 CALL prepare_out(fID_in, nlev_in, ntim_ou, fID_ou, levID_ou, timID_ou, vID_ou, & 549 ndims, cal_ou) 550 551 IF (is_mpi_root) THEN 552 553 !--- Write remaining coordinate variables: 554 CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in) 555 IF(interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday) 556 IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth) 557 558 IF (grid_type==unstructured) THEN 559 560 ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 561 DO i = 1, klon_glo 562 o3_out(ind_cell_glo_glo(i), :, :, :) = o3_out2_glo(i, :, :, :) 563 ENDDO 564 565 DO m = 1, read_climoz 566 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1, :, :, m)) 567 END DO 568 ELSE 569 !--- Write to file (the order of "rlatu" is inverted in the output file): 570 DO m = 1, read_climoz 571 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out2(nlat_ou:1:-1, :, :, m)) 572 END DO 573 ENDIF 574 575 CALL NF95_CLOSE(fID_ou) 576 577 ENDIF 578 579 !============================================================================= 580 END IF 581 !============================================================================= 582 583 IF (is_mpi_root) CALL NF95_CLOSE(fID_in) 584 585 ENDIF ! is_omp_master 586 587 first = .FALSE. 588 END SUBROUTINE regr_horiz_time_climoz 589 590 !------------------------------------------------------------------------------- 591 592 593 !------------------------------------------------------------------------------- 594 595 SUBROUTINE prepare_out(fID_in, nlev_in, ntim_ou, fID_ou, vlevID, vtimID, & 596 vID_ou, ndims, cal_ou) 597 !------------------------------------------------------------------------------- 598 ! Purpose: This subroutine creates the NetCDF output file, defines 599 ! dimensions and variables, and writes some of the coordinate variables. 600 !------------------------------------------------------------------------------- 601 USE regular_lonlat_mod, ONLY : lon_reg, lat_reg 602 USE regular_lonlat_mod, ONLY : lon_reg, lat_reg 603 USE mod_phys_lmdz_para, ONLY : is_mpi_root 604 USE mod_grid_phy_lmdz, ONLY : klon_glo 605 606 !------------------------------------------------------------------------------- 607 ! Arguments: 608 INTEGER, INTENT(IN) :: fID_in, nlev_in, ntim_ou 609 INTEGER, INTENT(OUT) :: fID_ou, vlevID, vtimID 610 INTEGER, INTENT(OUT) :: vID_ou(:) ! dim(1/2) 1: O3day&night 2: O3daylight 611 INTEGER, INTENT(IN) :: ndims ! fields rank (3 or 4) 612 CHARACTER(LEN = *), INTENT(IN) :: cal_ou ! calendar 613 !------------------------------------------------------------------------------- 614 ! Local variables: 615 INTEGER :: dlonID, dlatID, dlevID, dtimID, dIDs(4) 616 INTEGER :: vlonID, vlatID, ncerr, is 617 REAL, ALLOCATABLE :: latitude_glo_(:) 618 CHARACTER(LEN = 80) :: sub 619 INTEGER :: i 620 621 622 !------------------------------------------------------------------------------- 623 624 IF (is_mpi_root) THEN 625 sub = "prepare_out" 626 WRITE(lunout, *)"CALL sequence information: " // TRIM(sub) 627 CALL NF95_CREATE("climoz_LMDZ.nc", nf90_clobber, fID_ou) 628 629 !--- Dimensions: 630 IF(ndims==4) & 631 CALL nf95_def_dim(fID_ou, "rlonv", nlon_ou, dlonID) 632 CALL nf95_def_dim(fID_ou, "rlatu", nlat_ou, dlatID) 633 CALL nf95_def_dim(fID_ou, "plev", nlev_in, dlevID) 634 CALL nf95_def_dim(fID_ou, "time", ntim_ou, dtimID) 635 636 !--- Define coordinate variables: 637 IF(ndims==4) & 638 CALL nf95_def_var(fID_ou, "rlonv", nf90_float, dlonID, vlonID) 639 CALL nf95_def_var(fID_ou, "rlatu", nf90_float, dlatID, vlatID) 640 CALL nf95_def_var(fID_ou, "plev", nf90_float, dlevID, vlevID) 641 CALL nf95_def_var(fID_ou, "time", nf90_float, dtimID, vtimID) 642 IF(ndims==4) & 643 CALL NF95_PUT_ATT(fID_ou, vlonID, "units", "degrees_east") 644 CALL NF95_PUT_ATT(fID_ou, vlatID, "units", "degrees_north") 645 CALL NF95_PUT_ATT(fID_ou, vlevID, "units", "millibar") 646 CALL NF95_PUT_ATT(fID_ou, vtimID, "units", "days since 2000-1-1") 647 IF(ndims==4) & 648 CALL NF95_PUT_ATT(fID_ou, vlonID, "standard_name", "longitude") 649 CALL NF95_PUT_ATT(fID_ou, vlatID, "standard_name", "latitude") 650 CALL NF95_PUT_ATT(fID_ou, vlevID, "standard_name", "air_pressure") 651 CALL NF95_PUT_ATT(fID_ou, vtimID, "standard_name", "time") 652 CALL NF95_PUT_ATT(fID_ou, vlevID, "long_name", "air pressure") 653 CALL NF95_PUT_ATT(fID_ou, vtimID, "calendar", cal_ou) 654 655 !--- Define the main variables: 656 IF(ndims==3) dIDs(1:3) = [ dlatID, dlevID, dtimID] 657 IF(ndims==4) dIDs = [dlonID, dlatID, dlevID, dtimID] 658 CALL nf95_def_var(fID_ou, vars_in(1), nf90_float, dIDs(1:ndims), vID_ou(1)) 659 CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "long_name", "ozone mole fraction") 660 CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "standard_name", "mole_fraction_of_ozone& 661 _in_air") 662 IF(SIZE(vID_ou) == 2) THEN 663 CALL nf95_def_var(fID_ou, vars_in(2), nf90_float, dIDs(1:ndims), vID_ou(2)) 664 CALL NF95_PUT_ATT(fID_ou, vID_ou(2), "long_name", "ozone mole fraction in da& 665 ylight") 666 END IF 667 668 !--- Global attributes: 669 ! The following commands, copying attributes, may fail. That is OK. 670 ! It should just mean that the attribute is not defined in the input file. 671 CALL NF95_COPY_ATT(fID_in, nf90_global, "Conventions", fID_ou, nf90_global, ncerr) 672 CALL handle_err_copy_att("Conventions") 673 CALL NF95_COPY_ATT(fID_in, nf90_global, "title", fID_ou, nf90_global, ncerr) 674 CALL handle_err_copy_att("title") 675 CALL NF95_COPY_ATT(fID_in, nf90_global, "institution", fID_ou, nf90_global, ncerr) 676 CALL handle_err_copy_att("institution") 677 CALL NF95_COPY_ATT(fID_in, nf90_global, "source", fID_ou, nf90_global, ncerr) 678 CALL handle_err_copy_att("source") 679 CALL NF95_PUT_ATT (fID_ou, nf90_global, "comment", "Regridded for LMDZ") 680 CALL NF95_ENDDEF(fID_ou) 681 682 IF (grid_type==unstructured) THEN 683 ALLOCATE(latitude_glo_(klon_glo)) 684 DO i = 1, klon_glo 685 latitude_glo_(ind_cell_glo_glo(i)) = latitude_glo(i) 686 ENDDO 687 CALL NF95_PUT_VAR(fID_ou, vlatID, latitude_glo_) 225 688 ELSE 226 ntim_ou=14 227 cal_ou=cal_in 228 END IF 229 ENDIF 230 231 IF (grid_type==unstructured) THEN 232 CALL bcast_mpi(nlon_in) 233 CALL bcast_mpi(nlat_in) 234 CALL bcast_mpi(nlev_in) 235 CALL bcast_mpi(l3d) 236 CALL bcast_mpi(tmidmonth) 237 IF(interpt) CALL bcast_mpi(tmidday) 238 CALL bcast_mpi(ntim_ou) 239 240 IF (is_mpi_root) THEN 241 CALL xios_set_domain_attr("domain_climoz",nj_glo=nlat_in, nj=nlat_in, jbegin=0, latvalue_1d=lat_in/deg2rad) 242 IF (l3D) THEN 243 CALL xios_set_domain_attr("domain_climoz",ni_glo=nlon_in, ni=nlon_in, ibegin=0, lonvalue_1d=lon_in/deg2rad) 244 ELSE 245 CALL xios_set_domain_attr("domain_climoz",ni_glo=8, ni=8, ibegin=0, lonvalue_1d = (/ 0.,45.,90.,135.,180.,225.,270., 315. /)) 246 ENDIF 247 ELSE 248 CALL xios_set_domain_attr("domain_climoz",nj_glo=nlat_in, nj=0, jbegin=0, latvalue_1d=null_array ) 249 IF (l3D) THEN 250 CALL xios_set_domain_attr("domain_climoz",ni_glo=nlon_in, ni=0, ibegin=0, lonvalue_1d=null_array) 251 ELSE 252 CALL xios_set_domain_attr("domain_climoz",ni_glo=8, ni=0, ibegin=0, lonvalue_1d=null_array) 253 ENDIF 254 ENDIF 255 CALL xios_set_axis_attr("axis_climoz", n_glo=nlev_in) 256 CALL xios_set_axis_attr("time_axis_climoz", n_glo=ntim_ou) 257 CALL xios_set_axis_attr("time_axis_climoz", n_glo=ntim_ou) 258 CALL xios_set_axis_attr("tr_climoz", n_glo=read_climoz) 259 CALL xios_set_field_attr("tro3_out", enabled=.TRUE.) 260 CALL xios_set_field_attr("tro3_out", enabled=.TRUE.) 261 262 IF (first) THEN 263 first=.FALSE. 264 RETURN 689 !--- Write one of the coordinate variables: 690 IF(ndims==4) CALL NF95_PUT_VAR(fID_ou, vlonID, lon_reg / deg2rad) 691 CALL NF95_PUT_VAR(fID_ou, vlatID, lat_reg(nlat_ou:1:-1) / deg2rad) 692 ! (convert from rad to degrees and sort in ascending order) 265 693 ENDIF 266 694 ENDIF 267 268 269 IF (is_mpi_root) THEN 270 !--- Longitudes management: 271 ! * Need to shift data if the origin of input file longitudes /= -pi 272 ! * Need to add some margin in longitude to ensure input interval contains 273 ! all the output intervals => at least one longitudes slice has to be 274 ! duplicated, possibly more for undersampling. 275 IF(l3D) THEN 276 IF (grid_type==unstructured) THEN 277 dx2=0 278 ELSE 279 !--- Compute input edges longitudes vector (no end point yet) 280 ALLOCATE(v1(nlon_in+1)) 281 v1(1)=(lon_in(nlon_in)+lon_in(1))/2.-pi 282 FORALL(i=2:nlon_in) v1(i)=(lon_in(i-1)+lon_in(i))/2. 283 v1(nlon_in+1)=v1(1)+2.*pi 284 DEALLOCATE(lon_in) 285 286 !--- Shift input longitudes vector until it contains first output point boundslon_reg(1,west) 287 v1=v1+2*pi*REAL(FLOOR((boundslon_reg(1,west)-v1(1))/(2.*pi))) 288 289 !--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west) 290 dx1=locate(v1,boundslon_reg(1,west))-1 291 v1=CSHIFT(v1,SHIFT=dx1,DIM=1) 292 v1(nlon_in-dx1+2:)=v1(nlon_in-dx1+2:)+2.*pi 293 294 !--- Extend input longitudes vector until last interval contains boundslon_reg(nlat_ou,east) 295 dx2=0; DO WHILE(v1(1+dx2)+2.*pi<=boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO 296 297 !--- Final edges longitudes vector (with margin and end point) 298 ALLOCATE(lon_in_edge(nlon_in+dx2+1)); lon_in_edge=[v1,v1(2:1+dx2)+2.*pi] 299 DEALLOCATE(v1) 300 ENDIF 301 END IF 302 303 !--- Compute sinus of intervals edges latitudes: 304 ALLOCATE(sinlat_in_edge(nlat_in+1)) 305 sinlat_in_edge(1) = -1. ; sinlat_in_edge(nlat_in+1) = 1. 306 FORALL(j=2:nlat_in) sinlat_in_edge(j)=SIN((lat_in(j-1)+lat_in(j))/2.) 307 DEALLOCATE(lat_in) 308 309 310 311 !--- Check for contiguous years: 312 ib=0; ie=13 313 IF(nmth_in == 14) THEN; lprev=.FALSE.; lnext=.FALSE. 314 WRITE(lunout,*)'Using 14 months ozone climatology "climoz.nc"...' 315 ELSE 316 IF( lprev) WRITE(lunout,*)'Using "climoz_m.nc" last record (previous year).' 317 IF(.NOT.lprev) WRITE(lunout,*)"No previous year file ; assuming periodicity." 318 IF( lnext) WRITE(lunout,*)'Using "climoz_p.nc" first record (next year).' 319 IF(.NOT.lnext) WRITE(lunout,*)"No next year file ; assuming periodicity." 320 IF(.NOT.lprev) ib=1 321 IF(.NOT.lnext) ie=12 322 END IF 323 ALLOCATE(sta(ndims),cnt(ndims)); sta(:)=1 324 IF(l3D) cnt=[nlon_in,nlat_in,nlev_in,1] 325 IF(l2D) cnt=[ nlat_in,nlev_in,1] 326 IF(l3D) ALLOCATE(o3_in3(nlon_in+dx2,nlat_in,nlev_in,ib:ie,read_climoz)) 327 IF(l2D) ALLOCATE(o3_in2( nlat_in,nlev_in,ib:ie,read_climoz)) 328 329 !--- Read full current file and one record each available contiguous file 330 DO iv=1,read_climoz 331 CALL NF95_INQ_VARID(fID_in, vars_in(1), vID_in(iv)) 332 IF(l3D) call NF95_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv)) 333 IF(l2D) call NF95_GET_VAR(fID_in, vID_in(iv), o3_in2( :,:,1:12,iv)) 334 IF(lprev) THEN; sta(ndims)=12 335 CALL NF95_INQ_VARID(fID_in_m, vars_in(1), vID_in(iv)) 336 IF(l3D) call NF95_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt) 337 IF(l2d) call NF95_GET_VAR(fID_in_m,vID_in(iv),o3_in2( :,:, 0,iv),sta,cnt) 338 END IF 339 IF(lnext) THEN; sta(ndims)=1 340 CALL NF95_INQ_VARID(fID_in_p, vars_in(1), vID_in(iv)) 341 IF(l3D) call NF95_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt) 342 IF(l2D) call NF95_GET_VAR(fID_in_p,vID_in(iv),o3_in2( :,:,13,iv),sta,cnt) 343 END IF 344 END DO 345 IF(lprev.OR.lnext) DEALLOCATE(sta,cnt) 346 IF(lprev) CALL NF95_CLOSE(fID_in_m) 347 IF(lnext) CALL NF95_CLOSE(fID_in_p) 348 349 !--- Revert decreasing coordinates vector 350 IF(l3D) THEN 351 IF(ldec_lon) o3_in3(1:nlon_in,:,:,:,:) = o3_in3(nlon_in:1:-1,:,:,:,:) 352 IF(ldec_lat) o3_in3 = o3_in3(:,nlat_in:1:-1,:,:,:) 353 IF(ldec_lev) o3_in3 = o3_in3(:,:,nlev_in:1:-1,:,:) 354 355 IF (grid_type /= unstructured) THEN 356 !--- Shift values for longitude and duplicate some longitudes slices 357 o3_in3(1:nlon_in,:,:,:,:)=CSHIFT(o3_in3(1:nlon_in,:,:,:,:),SHIFT=dx1,DIM=1) 358 o3_in3(nlon_in+1:nlon_in+dx2,:,:,:,:)=o3_in3(1:dx2,:,:,:,:) 359 ENDIF 360 ELSE 361 IF(ldec_lat) o3_in2 = o3_in2( nlat_in:1:-1,:,:,:) 362 IF(ldec_lev) o3_in2 = o3_in2( :,nlev_in:1:-1,:,:) 363 END IF 364 365 !--- Deal with missing values 366 DO m=1, read_climoz 367 WRITE(msg,'(a,i0)')"regr_lat_time_climoz: field Nr.",m 368 IF(NF90_GET_ATT(fID_in,vID_in(m),"missing_value",NaN)/= nf90_noerr) THEN 369 IF(NF90_GET_ATT(fID_in, vID_in(m),"_FillValue",NaN)/= nf90_noerr) THEN 370 WRITE(lunout,*)TRIM(msg)//": no missing value attribute found."; CYCLE 371 END IF 372 END IF 373 WRITE(lunout,*)TRIM(msg)//": missing value attribute found." 374 WRITE(lunout,*)"Trying to fill in NaNs ; a full field would be better." 375 376 !--- Check top layer contains no NaNs & search NaNs from top to ground 377 msg=TRIM(sub)//": NaNs in top layer !" 378 IF(l3D) THEN 379 IF(ANY(o3_in3(:,:,1,:,m)==NaN)) CALL abort_physic(sub,msg,1) 380 DO k = 2,nlev_in 381 WHERE(o3_in3(:,:,k,:,m)==NaN) o3_in3(:,:,k,:,m)=o3_in3(:,:,k-1,:,m) 382 END DO 383 ELSE 384 IF(ANY(o3_in2( :,1,:,m)==NaN)) THEN 385 WRITE(lunout,*)msg 386 !--- Fill in latitudes where all values are missing 387 DO l=1,nmth_in 388 !--- Next to south pole 389 j=1; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO 390 IF(j>1) & 391 o3_in2(:j-1,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=j-1) 392 !--- Next to north pole 393 j=nlat_in; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO 394 IF(j<nlat_in) & 395 o3_in2(j+1:,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=nlat_in-j) 396 END DO 397 END IF 398 399 !--- Fill in high latitudes missing values 400 !--- Highest level been filled-in, so has always valid values. 401 DO k = 2,nlev_in 402 WHERE(o3_in2(:,k,:,m)==NaN) o3_in2(:,k,:,m)=o3_in2(:,k-1,:,m) 403 END DO 404 END IF 405 END DO 406 407 ENDIF 408 409 !============================================================================= 410 IF(l3D) THEN !=== 3D FIELDS 411 !============================================================================= 412 IF (grid_type==unstructured) THEN 413 nlat_ou=klon_mpi 414 415 IF (is_mpi_root) THEN 416 ALLOCATE(o3_in3bis(nlon_in,nlat_in,nlev_in,0:13,read_climoz)) 417 o3_in3bis(:,:,:,ib:ie,:)=o3_in3(1:nlon_in,:,:,ib:ie,:) 418 ELSE 419 ALLOCATE(o3_in3bis(0,0,0,0,read_climoz)) 420 ENDIF 421 ALLOCATE(o3_regr_lonlat(1, nlat_ou, nlev_in, 0:13, read_climoz)) 422 423 CALL xios_send_field("tro3_in",o3_in3bis(:,:,:,:,:)) 424 CALL xios_recv_field("tro3_out",o3_regr_lonlat(1,:,:,:,:)) 425 ELSE 426 427 !--- Regrid in longitude 428 ALLOCATE(o3_regr_lon(nlon_ou, nlat_in, nlev_in, ie-ib+1, read_climoz)) 429 CALL regr_conserv(1, o3_in3, xs = lon_in_edge, & 430 xt = [boundslon_reg(1,west),boundslon_reg(:,east)], & 431 vt = o3_regr_lon, slope = slopes(1,o3_in3, lon_in_edge)) 432 DEALLOCATE(o3_in3) 433 434 !--- Regrid in latitude: averaging with respect to SIN(lat) is 435 ! equivalent to weighting by COS(lat) 436 !--- (inverted indices in "o3_regr_lonlat" because "rlatu" is decreasing) 437 ALLOCATE(o3_regr_lonlat(nlon_ou, nlat_ou, nlev_in, 0:13, read_climoz)) 438 CALL regr_conserv(2, o3_regr_lon, xs = sinlat_in_edge, & 439 xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], & 440 vt = o3_regr_lonlat(:,nlat_ou:1:- 1,:,ib:ie,:), & 441 slope = slopes(2,o3_regr_lon, sinlat_in_edge)) 442 DEALLOCATE(o3_regr_lon) 443 444 ENDIF 445 446 !--- Duplicate previous/next record(s) if they are not available 447 IF(.NOT.lprev) o3_regr_lonlat(:,:,:, 0,:) = o3_regr_lonlat(:,:,:,12,:) 448 IF(.NOT.lnext) o3_regr_lonlat(:,:,:,13,:) = o3_regr_lonlat(:,:,:, 1,:) 449 450 !--- Regrid in time by linear interpolation: 451 ALLOCATE(o3_out3(nlon_ou, nlat_ou, nlev_in, ntim_ou, read_climoz)) 452 IF( interpt) CALL regr_lint(4,o3_regr_lonlat,tmidmonth,tmidday,o3_out3) 453 IF(.NOT.interpt) o3_out3=o3_regr_lonlat 454 DEALLOCATE(o3_regr_lonlat) 455 456 nlat_ou=nbp_lat 457 IF (grid_type==unstructured) THEN 458 CALL xios_send_field('o3_out',o3_out3) 459 ndims=3 460 ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 461 CALL gather_mpi(o3_out3(1,:,:,:,:), o3_out3_glo) 462 ENDIF 463 464 !--- Create the output file and get the variable IDs: 465 CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, & 466 ndims, cal_ou) 467 468 IF (is_mpi_root) THEN 469 !--- Write remaining coordinate variables: 470 CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in) 471 IF( interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday) 472 IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth) 473 474 !--- Write to file (the order of "rlatu" is inverted in the output file): 475 IF (grid_type==unstructured) THEN 476 477 ALLOCATE(o3_out(nlat_ou, nlev_in, ntim_ou, read_climoz)) 478 DO i=1,klon_glo 479 o3_out(ind_cell_glo_glo(i),:,:,:)=o3_out3_glo(i,:,:,:) 480 ENDDO 481 482 DO m = 1, read_climoz 483 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1,:,:,m)) 484 END DO 485 486 ELSE 487 DO m = 1, read_climoz 488 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out3(:,nlat_ou:1:-1,:,:,m)) 489 END DO 490 ENDIF 491 CALL NF95_CLOSE(fID_ou) 492 493 494 ENDIF 495 496 497 !============================================================================= 498 ELSE !=== ZONAL FIELDS 499 !============================================================================= 500 501 IF (grid_type==unstructured) THEN 502 nlat_ou=klon_mpi 503 504 IF (is_mpi_root) THEN 505 ALLOCATE(o3_in2bis(8,nlat_in,nlev_in,0:13,read_climoz)) 506 o3_in2bis(:,:,:,ib:ie,:)=SPREAD(o3_in2,1,8) 507 ELSE 508 ALLOCATE(o3_in2bis(0,0,0,0,read_climoz)) 509 ENDIF 510 ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz)) 511 CALL xios_send_field("tro3_in",o3_in2bis(:,:,:,:,:)) 512 CALL xios_recv_field("tro3_out",o3_regr_lat(:,:,:,:)) 513 IF(.NOT.lprev) o3_regr_lat(:,:, 0, :) = o3_regr_lat(:,:,12,:) 514 IF(.NOT.lnext) o3_regr_lat(:,:,13, :) = o3_regr_lat(:,:, 1,:) 515 516 ELSE 517 !--- Regrid in latitude: averaging with respect to SIN(lat) is 518 ! equivalent to weighting by COS(lat) 519 !--- (inverted indices in "o3_regr_lat" because "rlatu" is decreasing) 520 ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz)) 521 CALL regr_conserv(1, o3_in2, xs = sinlat_in_edge, & 522 xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], & 523 vt = o3_regr_lat(nlat_ou:1:- 1,:,ib:ie,:), & 524 slope = slopes(1,o3_in2, sinlat_in_edge)) 525 DEALLOCATE(o3_in2) 526 527 !--- Duplicate previous/next record(s) if they are not available 528 IF(.NOT.lprev) o3_regr_lat(:,:, 0,:) = o3_regr_lat(:,:,12,:) 529 IF(.NOT.lnext) o3_regr_lat(:,:,13,:) = o3_regr_lat(:,:, 1,:) 530 531 ENDIF 532 533 !--- Regrid in time by linear interpolation: 534 ALLOCATE(o3_out2(nlat_ou, nlev_in, ntim_ou, read_climoz)) 535 IF( interpt) CALL regr_lint(3,o3_regr_lat, tmidmonth, tmidday, o3_out2) 536 IF(.NOT.interpt) o3_out2=o3_regr_lat 537 DEALLOCATE(o3_regr_lat) 538 539 nlat_ou=nbp_lat 540 541 IF (grid_type==unstructured) THEN 542 ndims=3 543 ALLOCATE(o3_out2_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 544 CALL gather_mpi(o3_out2, o3_out2_glo) 545 ENDIF 546 547 !--- Create the output file and get the variable IDs: 548 CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, & 549 ndims, cal_ou) 550 551 IF (is_mpi_root) THEN 552 553 !--- Write remaining coordinate variables: 554 CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in) 555 IF( interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday) 556 IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth) 557 558 IF (grid_type==unstructured) THEN 559 560 ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 561 DO i=1,klon_glo 562 o3_out(ind_cell_glo_glo(i),:,:,:)=o3_out2_glo(i,:,:,:) 563 ENDDO 564 565 566 DO m = 1, read_climoz 567 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1,:,:,m)) 568 END DO 569 ELSE 570 !--- Write to file (the order of "rlatu" is inverted in the output file): 571 DO m = 1, read_climoz 572 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out2(nlat_ou:1:-1,:,:,m)) 573 END DO 574 ENDIF 575 576 CALL NF95_CLOSE(fID_ou) 577 578 ENDIF 579 580 !============================================================================= 581 END IF 582 !============================================================================= 583 584 IF (is_mpi_root) CALL NF95_CLOSE(fID_in) 585 586 ENDIF ! is_omp_master 587 588 first=.FALSE. 589 END SUBROUTINE regr_horiz_time_climoz 695 696 CONTAINS 697 698 !------------------------------------------------------------------------------- 699 700 SUBROUTINE handle_err_copy_att(att_name) 701 702 !------------------------------------------------------------------------------- 703 USE netcdf, ONLY : nf90_noerr, NF90_strerror 704 !------------------------------------------------------------------------------- 705 ! Arguments: 706 CHARACTER(LEN = *), INTENT(IN) :: att_name 707 !------------------------------------------------------------------------------- 708 IF(ncerr /= nf90_noerr) & 709 WRITE(lunout, *)TRIM(sub) // " prepare_out NF95_COPY_ATT " // TRIM(att_name) // & 710 " -- " // TRIM(NF90_strerror(ncerr)) 711 712 END SUBROUTINE handle_err_copy_att 713 714 !------------------------------------------------------------------------------- 715 716 END SUBROUTINE prepare_out 717 718 !------------------------------------------------------------------------------- 719 720 END MODULE regr_horiz_time_climoz_m 590 721 591 722 !------------------------------------------------------------------------------- 592 593 594 !-------------------------------------------------------------------------------595 596 SUBROUTINE prepare_out(fID_in, nlev_in, ntim_ou, fID_ou, vlevID, vtimID, &597 vID_ou, ndims, cal_ou)598 !-------------------------------------------------------------------------------599 ! Purpose: This subroutine creates the NetCDF output file, defines600 ! dimensions and variables, and writes some of the coordinate variables.601 !-------------------------------------------------------------------------------602 USE regular_lonlat_mod, ONLY: lon_reg, lat_reg603 USE regular_lonlat_mod, ONLY: lon_reg, lat_reg604 USE mod_phys_lmdz_para, ONLY: is_mpi_root605 USE mod_grid_phy_lmdz, ONLY: klon_glo606 607 !-------------------------------------------------------------------------------608 ! Arguments:609 INTEGER, INTENT(IN) :: fID_in, nlev_in, ntim_ou610 INTEGER, INTENT(OUT) :: fID_ou, vlevID, vtimID611 INTEGER, INTENT(OUT) :: vID_ou(:) ! dim(1/2) 1: O3day&night 2: O3daylight612 INTEGER, INTENT(IN) :: ndims ! fields rank (3 or 4)613 CHARACTER(LEN=*), INTENT(IN) :: cal_ou ! calendar614 !-------------------------------------------------------------------------------615 ! Local variables:616 INTEGER :: dlonID, dlatID, dlevID, dtimID, dIDs(4)617 INTEGER :: vlonID, vlatID, ncerr, is618 REAL,ALLOCATABLE :: latitude_glo_(:)619 CHARACTER(LEN=80) :: sub620 INTEGER :: i621 622 623 !-------------------------------------------------------------------------------624 625 IF (is_mpi_root) THEN626 sub="prepare_out"627 WRITE(lunout,*)"CALL sequence information: "//TRIM(sub)628 CALL NF95_CREATE("climoz_LMDZ.nc", NF90_clobber, fID_ou)629 630 !--- Dimensions:631 IF(ndims==4) &632 CALL NF95_DEF_DIM(fID_ou, "rlonv", nlon_ou, dlonID)633 CALL NF95_DEF_DIM(fID_ou, "rlatu", nlat_ou, dlatID)634 CALL NF95_DEF_DIM(fID_ou, "plev", nlev_in, dlevID)635 CALL NF95_DEF_DIM(fID_ou, "time", ntim_ou, dtimID)636 637 !--- Define coordinate variables:638 IF(ndims==4) &639 CALL NF95_DEF_VAR(fID_ou, "rlonv", NF90_FLOAT, dlonID, vlonID)640 CALL NF95_DEF_VAR(fID_ou, "rlatu", NF90_FLOAT, dlatID, vlatID)641 CALL NF95_DEF_VAR(fID_ou, "plev", NF90_FLOAT, dlevID, vlevID)642 CALL NF95_DEF_VAR(fID_ou, "time", NF90_FLOAT, dtimID, vtimID)643 IF(ndims==4) &644 CALL NF95_PUT_ATT(fID_ou, vlonID, "units", "degrees_east")645 CALL NF95_PUT_ATT(fID_ou, vlatID, "units", "degrees_north")646 CALL NF95_PUT_ATT(fID_ou, vlevID, "units", "millibar")647 CALL NF95_PUT_ATT(fID_ou, vtimID, "units", "days since 2000-1-1")648 IF(ndims==4) &649 CALL NF95_PUT_ATT(fID_ou, vlonID, "standard_name", "longitude")650 CALL NF95_PUT_ATT(fID_ou, vlatID, "standard_name", "latitude")651 CALL NF95_PUT_ATT(fID_ou, vlevID, "standard_name", "air_pressure")652 CALL NF95_PUT_ATT(fID_ou, vtimID, "standard_name", "time")653 CALL NF95_PUT_ATT(fID_ou, vlevID, "long_name", "air pressure")654 CALL NF95_PUT_ATT(fID_ou, vtimID, "calendar", cal_ou)655 656 !--- Define the main variables:657 IF(ndims==3) dIDs(1:3) = [ dlatID, dlevID, dtimID]658 IF(ndims==4) dIDs=[dlonID, dlatID, dlevID, dtimID]659 CALL NF95_DEF_VAR(fID_ou, vars_in(1), NF90_FLOAT, dIDs(1:ndims), vID_ou(1))660 CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "long_name", "ozone mole fraction")661 CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "standard_name", "mole_fraction_of_ozone&662 _in_air")663 IF(SIZE(vID_ou) == 2) THEN664 CALL NF95_DEF_VAR(fID_ou, vars_in(2), NF90_FLOAT, dIDs(1:ndims), vID_ou(2))665 CALL NF95_PUT_ATT(fID_ou, vID_ou(2), "long_name","ozone mole fraction in da&666 ylight")667 END IF668 669 !--- Global attributes:670 ! The following commands, copying attributes, may fail. That is OK.671 ! It should just mean that the attribute is not defined in the input file.672 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"Conventions",fID_ou,NF90_GLOBAL, ncerr)673 CALL handle_err_copy_att("Conventions")674 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"title", fID_ou,NF90_GLOBAL, ncerr)675 CALL handle_err_copy_att("title")676 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"institution",fID_ou,NF90_GLOBAL, ncerr)677 CALL handle_err_copy_att("institution")678 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"source", fID_ou,NF90_GLOBAL, ncerr)679 CALL handle_err_copy_att("source")680 CALL NF95_PUT_ATT (fID_ou,NF90_GLOBAL,"comment", "Regridded for LMDZ")681 CALL NF95_ENDDEF(fID_ou)682 683 IF (grid_type==unstructured) THEN684 ALLOCATE(latitude_glo_(klon_glo))685 DO i=1,klon_glo686 latitude_glo_(ind_cell_glo_glo(i))=latitude_glo(i)687 ENDDO688 CALL NF95_PUT_VAR(fID_ou, vlatID, latitude_glo_)689 ELSE690 !--- Write one of the coordinate variables:691 IF(ndims==4) CALL NF95_PUT_VAR(fID_ou, vlonID, lon_reg/deg2rad)692 CALL NF95_PUT_VAR(fID_ou, vlatID, lat_reg(nlat_ou:1:-1)/deg2rad)693 ! (convert from rad to degrees and sort in ascending order)694 ENDIF695 ENDIF696 697 CONTAINS698 699 !-------------------------------------------------------------------------------700 701 SUBROUTINE handle_err_copy_att(att_name)702 703 !-------------------------------------------------------------------------------704 USE netcdf, ONLY: nf90_noerr, NF90_strerror705 !-------------------------------------------------------------------------------706 ! Arguments:707 CHARACTER(LEN=*), INTENT(IN) :: att_name708 !-------------------------------------------------------------------------------709 IF(ncerr /= nf90_noerr) &710 WRITE(lunout,*)TRIM(sub)//" prepare_out NF95_COPY_ATT "//TRIM(att_name)// &711 " -- "//TRIM(NF90_strerror(ncerr))712 713 END SUBROUTINE handle_err_copy_att714 715 !-------------------------------------------------------------------------------716 717 END SUBROUTINE prepare_out718 719 !-------------------------------------------------------------------------------720 721 END MODULE regr_horiz_time_climoz_m722 723 !------------------------------------------------------------------------------- -
LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_time_av_m.F90
r5099 r5100 113 113 !------------------------------------------------------------------------------- 114 114 USE dimphy, ONLY: klon 115 USE netcdf95, ONLY: NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, &116 NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION, nf95_get_var115 USE netcdf95, ONLY: nf95_inq_varid, NF95_INQUIRE_VARIABLE, & 116 nf95_inq_dimid, nf95_inquire_dimension, nf95_get_var 117 117 USE netcdf, ONLY: NF90_INQ_VARID, nf90_noerr 118 118 USE assert_m, ONLY: assert … … 213 213 lPrTfile=lAdjTro.AND.NF90_INQ_VARID(fID,"tropopause_air_pressure",vID)==nf90_noerr 214 214 lO3Tfile=lAdjTro.AND.NF90_INQ_VARID(fID,"tro3_at_tropopause" ,vID)==nf90_noerr 215 CALL NF95_INQ_DIMID(fID,"time",vID)216 CALL NF95_INQUIRE_DIMENSION(fID,vID,nclen=ntim_in)215 CALL nf95_inq_dimid(fID,"time",vID) 216 CALL nf95_inquire_dimension(fID,vID,nclen=ntim_in) 217 217 linterp=PRESENT(time_in).AND.ntim_in==14 218 218 ALLOCATE(v1(nlon,nlat,nlev_in,n_var)) … … 480 480 CHARACTER(LEN=*), INTENT(IN) :: var 481 481 !------------------------------------------------------------------------------- 482 CALL NF95_INQ_VARID(fID, TRIM(var), vID)482 CALL nf95_inq_varid(fID, TRIM(var), vID) 483 483 CALL NF95_INQUIRE_VARIABLE(fID, vID, ndims=n_dim) 484 484 IF(n_dim==2) call NF95_GET_VAR(fID,vID,v(1,:), start=[ 1,irec]) … … 511 511 !------------------------------------------------------------------------------- 512 512 DO i=1,SIZE(nam) 513 CALL NF95_INQ_VARID(fID, TRIM(nam(i)), vID)513 CALL nf95_inq_varid(fID, TRIM(nam(i)), vID) 514 514 CALL NF95_INQUIRE_VARIABLE(fID, vID, ndims=n_dim) 515 515 IF(n_dim==3) call NF95_GET_VAR(fID,vID,v(1,:,:,i), start=[ 1,1,irec]) -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/limit_read_mod.F90
r5099 r5100 352 352 !$OMP MASTER ! Only master thread 353 353 IF (is_mpi_root) THEN ! Only master processus 354 ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)354 ierr = nf90_open ('limit.nc', nf90_nowrite, nid) 355 355 IF (ierr /= nf90_noerr) CALL abort_physic(modname,& 356 356 'Pb d''ouverture du fichier de conditions aux limites',1) … … 358 358 !--- WARNING IF CALENDAR IS KNOWN AND DOES NOT MATCH THE ONE OF LMDZ 359 359 ierr=NF90_INQ_VARID(nid, 'TEMPS', nvarid) 360 ierr= NF90_GET_ATT(nid, nvarid, 'calendar', calendar)360 ierr=nf90_get_att(nid, nvarid, 'calendar', calendar) 361 361 IF(ierr==nf90_noerr.AND.calendar/=calend.AND.prt_level>=1) THEN 362 362 WRITE(lunout,*)'BEWARE: gcm and limit.nc calendars differ: ' … … 387 387 IF(nn/=klon_glo) CALL abort_physic(modname,abort_message,1) 388 388 389 ierr = NF90_CLOSE(nid)389 ierr = nf90_close(nid) 390 390 IF (ierr /= nf90_noerr) CALL abort_physic(modname,'Pb when closing file', 1) 391 391 END IF ! is_mpi_root … … 450 450 IF (is_mpi_root) THEN ! Only master processus! 451 451 452 ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)452 ierr = nf90_open ('limit.nc', nf90_nowrite, nid) 453 453 IF (ierr /= nf90_noerr) CALL abort_physic(modname,& 454 454 'Pb d''ouverture du fichier de conditions aux limites',1) … … 564 564 565 565 !**************************************************************************************** 566 ierr = NF90_CLOSE(nid)566 ierr = nf90_close(nid) 567 567 IF (ierr /= nf90_noerr) CALL abort_physic(modname,'Pb when closing file', 1) 568 568 ENDIF ! is_mpi_root -
LMDZ6/branches/Amaury_dev/tools/make_sso/make_sso_SpherePack.f90
r5099 r5100 117 117 SELECT CASE(arg) 118 118 CASE('-i'); f_in=args(k); msg='Missing file "'//TRIM(f_in)//'".' 119 ll= NF90_OPEN(f_in,NF90_NOWRITE,fID)/=nf90_noerr120 IF(.NOT.ll) n= NF90_CLOSE(fID)119 ll=nf90_open(f_in,nf90_nowrite,fID)/=nf90_noerr 120 IF(.NOT.ll) n=nf90_close(fID) 121 121 CASE('-res'); nlon_ou=str2int(args(k)); k=k+1 122 122 nlat_ou=str2int(args(k)) … … 135 135 IF(ALL(['noro','spec']/=fmsk)) THEN 136 136 msg='Missing or wrong "-m" option ; can be "noro", "spec" or a mask file' 137 CALL err( NF90_OPEN(fmsk,NF90_NOWRITE,fID)/=nf90_noerr,msg)137 CALL err(nf90_open(fmsk,nf90_nowrite,fID)/=nf90_noerr,msg) 138 138 CALL nc(NF90_INQ_VARID(fID,"MaskOcean",vID),"MaskOcean") !--- MASK ID 139 139 CALL nc(NF90_INQUIRE_VARIABLE(fID,vID,dimids=dIDs)) !--- DIMS IDS 140 140 CALL nc(nf90_inquire_dimension(fID,dIDs(1),len=nlon_ou),'x')!--- NB LONG 141 141 CALL nc(nf90_inquire_dimension(fID,dIDs(2),len=nlat_ou),'y')!--- NB LAT 142 CALL nc( NF90_CLOSE(fID))142 CALL nc(nf90_close(fID)) 143 143 END IF 144 144 IF(nlon_ou<=0.OR.nlat_ou<=0) THEN … … 147 147 148 148 !=== READ THE INPUT FIELD ======================================================= 149 CALL nc( NF90_OPEN(f_in,NF90_NOWRITE,fID))149 CALL nc(nf90_open(f_in,nf90_nowrite,fID)) 150 150 WRITE(*,*)'>> Reading variable "'//TRIM(vnam)//'" from "'//TRIM(f_in)//'"...' 151 151 … … 163 163 CALL nc(nf90_get_var (fID,loID,lon_in) ,lonn) 164 164 CALL nc(nf90_get_var (fID,laID,lat_in) ,latn) 165 CALL nc( NF90_GET_ATT(fID,loID,'units',lonu),lonn)166 CALL nc( NF90_GET_ATT(fID,laID,'units',latu),latn)165 CALL nc(nf90_get_att (fID,loID,'units',lonu),lonn) 166 CALL nc(nf90_get_att (fID,laID,'units',latu),latn) 167 167 CALL nc(nf90_get_var (fID,vID,h(:,:),[1,1],[nlon_in+1,nlat_in]),vnam) 168 CALL nc( NF90_CLOSE(fID))168 CALL nc(nf90_close(fID)) 169 169 170 170 !--- CHECK WETHER GRID IS CORRECT (GLOBAL DOMAIN, IDENTIFIED UNITS...) … … 368 368 ALLOCATE(msko(nlon_ou,nlat_ou)) 369 369 msg='Missing or wrong "-m" option ; can be "noro", "spec" or a mask file' 370 CALL err( NF90_OPEN(fmsk,NF90_NOWRITE,fID)/=nf90_noerr,msg)370 CALL err(nf90_open(fmsk,nf90_nowrite,fID)/=nf90_noerr,msg) 371 371 CALL nc(NF90_INQ_VARID(fID,"MaskOcean",vID),"MaskOcean") !--- MASK ID 372 372 CALL nc(nf90_get_var(fID,vID,msko(:,:))) !--- MASK 373 CALL nc( NF90_CLOSE(fID))373 CALL nc(nf90_close(fID)) 374 374 msko(:,:)=1.0-msko(:,:) 375 375 END SELECT … … 457 457 f_ou='make_sso_'//TRIM(res_ou)//'_'//TRIM(f_in) 458 458 fnam=f_ou 459 CALL nc( NF90_CREATE(f_ou,NF90_CLOBBER,fID))460 461 CALL nc( NF90_DEF_DIM(fID,'x',nlon_ou,xID))462 CALL nc( NF90_DEF_VAR(fID,'x',NF90_REAL,xID,loID) ,'x')463 CALL nc( NF90_PUT_ATT(fID,loID,'long_name','Longitude'),'x')464 CALL nc( NF90_PUT_ATT(fID,loID,'units','degrees_east') ,'x')465 466 CALL nc( NF90_DEF_DIM(fID,'y',nlat_ou,yID))467 CALL nc( NF90_DEF_VAR(fID,'y',NF90_REAL,yID,laID) ,'y')468 CALL nc( NF90_PUT_ATT(fID,laID,'long_name','Latitude') ,'y')469 CALL nc( NF90_PUT_ATT(fID,laID,'units','degrees_north'),'y')470 471 CALL nc( NF90_DEF_VAR(fID,'mask',NF90_REAL,[xID,yID],mskID),'mask')459 CALL nc(nf90_create(f_ou,nf90_clobber,fID)) 460 461 CALL nc(nf90_def_dim(fID,'x',nlon_ou,xID)) 462 CALL nc(nf90_def_var(fID,'x',NF90_REAL,xID,loID) ,'x') 463 CALL nc(nf90_put_att(fID,loID,'long_name','Longitude'),'x') 464 CALL nc(nf90_put_att(fID,loID,'units','degrees_east') ,'x') 465 466 CALL nc(nf90_def_dim(fID,'y',nlat_ou,yID)) 467 CALL nc(nf90_def_var(fID,'y',NF90_REAL,yID,laID) ,'y') 468 CALL nc(nf90_put_att(fID,laID,'long_name','Latitude') ,'y') 469 CALL nc(nf90_put_att(fID,laID,'units','degrees_north'),'y') 470 471 CALL nc(nf90_def_var(fID,'mask',NF90_REAL,[xID,yID],mskID),'mask') 472 472 IF(fmsk=='noro') & 473 CALL nc( NF90_DEF_VAR(fID,'Zphi',NF90_REAL,[xID,yID],phiID),'Zphi')474 CALL nc( NF90_DEF_VAR(fID,'Zmea',NF90_REAL,[xID,yID],meaID),'Zmea')475 CALL nc( NF90_DEF_VAR(fID,'mu' ,NF90_REAL,[xID,yID], muID),'mu' )476 CALL nc( NF90_DEF_VAR(fID,'Zsig',NF90_REAL,[xID,yID],sigID),'Zsig')477 CALL nc( NF90_DEF_VAR(fID,'Zgam',NF90_REAL,[xID,yID],gamID),'Zgam')478 CALL nc( NF90_DEF_VAR(fID,'Zthe',NF90_REAL,[xID,yID],theID),'Zthe')479 CALL nc( NF90_DEF_VAR(fID,'Zpic',NF90_REAL,[xID,yID],picID),'Zpic')480 CALL nc( NF90_DEF_VAR(fID,'Zval',NF90_REAL,[xID,yID],valID),'Zval')481 482 CALL nc( NF90_PUT_ATT(fID,mskID,'long_name','Fractional land mask' ),'mask')473 CALL nc(nf90_def_var(fID,'Zphi',NF90_REAL,[xID,yID],phiID),'Zphi') 474 CALL nc(nf90_def_var(fID,'Zmea',NF90_REAL,[xID,yID],meaID),'Zmea') 475 CALL nc(nf90_def_var(fID,'mu' ,NF90_REAL,[xID,yID], muID),'mu' ) 476 CALL nc(nf90_def_var(fID,'Zsig',NF90_REAL,[xID,yID],sigID),'Zsig') 477 CALL nc(nf90_def_var(fID,'Zgam',NF90_REAL,[xID,yID],gamID),'Zgam') 478 CALL nc(nf90_def_var(fID,'Zthe',NF90_REAL,[xID,yID],theID),'Zthe') 479 CALL nc(nf90_def_var(fID,'Zpic',NF90_REAL,[xID,yID],picID),'Zpic') 480 CALL nc(nf90_def_var(fID,'Zval',NF90_REAL,[xID,yID],valID),'Zval') 481 482 CALL nc(nf90_put_att(fID,mskID,'long_name','Fractional land mask' ),'mask') 483 483 IF(fmsk=='noro') & 484 CALL nc( NF90_PUT_ATT(fID,phiID,'long_name','Geopotential' ),'Zphi')485 CALL nc( NF90_PUT_ATT(fID,meaID,'long_name','Mean orography' ),'Zmea')486 CALL nc( NF90_PUT_ATT(fID, muID,'long_name','Std deviation of sub-cell scales orography'),'mu' )487 CALL nc( NF90_PUT_ATT(fID,sigID,'long_name','Slope along principal axis' ),'Zsig')488 CALL nc( NF90_PUT_ATT(fID,gamID,'long_name','Anisotropy (aspect ratio)' ),'Zgam')489 CALL nc( NF90_PUT_ATT(fID,theID,'long_name','Orientation (principal axis)' ),'Zthe')490 CALL nc( NF90_PUT_ATT(fID,picID,'long_name','Maximum height' ),'Zpic')491 CALL nc( NF90_PUT_ATT(fID,valID,'long_name','Minimum height' ),'Zval')492 493 CALL nc( NF90_PUT_ATT(fID,mskID,'units','none' ),'mask')484 CALL nc(nf90_put_att(fID,phiID,'long_name','Geopotential' ),'Zphi') 485 CALL nc(nf90_put_att(fID,meaID,'long_name','Mean orography' ),'Zmea') 486 CALL nc(nf90_put_att(fID, muID,'long_name','Std deviation of sub-cell scales orography'),'mu' ) 487 CALL nc(nf90_put_att(fID,sigID,'long_name','Slope along principal axis' ),'Zsig') 488 CALL nc(nf90_put_att(fID,gamID,'long_name','Anisotropy (aspect ratio)' ),'Zgam') 489 CALL nc(nf90_put_att(fID,theID,'long_name','Orientation (principal axis)' ),'Zthe') 490 CALL nc(nf90_put_att(fID,picID,'long_name','Maximum height' ),'Zpic') 491 CALL nc(nf90_put_att(fID,valID,'long_name','Minimum height' ),'Zval') 492 493 CALL nc(nf90_put_att(fID,mskID,'units','none' ),'mask') 494 494 IF(fmsk=='noro') & 495 CALL nc( NF90_PUT_ATT(fID,phiID,'units','m' ),'Zphi')496 CALL nc( NF90_PUT_ATT(fID,meaID,'units','m' ),'Zmea')497 CALL nc( NF90_PUT_ATT(fID, muID,'units','m' ),'mu' )498 CALL nc( NF90_PUT_ATT(fID,sigID,'units','m/m' ),'Zsig')499 CALL nc( NF90_PUT_ATT(fID,gamID,'units','none' ),'Zgam')500 CALL nc( NF90_PUT_ATT(fID,theID,'units','degrees'),'Zthe')501 CALL nc( NF90_PUT_ATT(fID,picID,'units','m' ),'Zpic')502 CALL nc( NF90_PUT_ATT(fID,valID,'units','m' ),'Zval')503 504 CALL nc( NF90_PUT_ATT(fID,NF90_GLOBAL,'Conventions','COARDS/CF-1.0'))505 CALL nc( NF90_PUT_ATT(fID,NF90_GLOBAL,'Initial_Grid',TRIM(res_in)))506 CALL nc( NF90_PUT_ATT(fID,NF90_GLOBAL,'history',TRIM(call_seq)))507 CALL nc( NF90_ENDDEF(fID))508 509 CALL nc( NF90_PUT_VAR(fID, loID,lon_ou),'x' )510 CALL nc( NF90_PUT_VAR(fID, laID,lat_ou),'y' )511 CALL nc( NF90_PUT_VAR(fID,mskID,msko),'mask')495 CALL nc(nf90_put_att(fID,phiID,'units','m' ),'Zphi') 496 CALL nc(nf90_put_att(fID,meaID,'units','m' ),'Zmea') 497 CALL nc(nf90_put_att(fID, muID,'units','m' ),'mu' ) 498 CALL nc(nf90_put_att(fID,sigID,'units','m/m' ),'Zsig') 499 CALL nc(nf90_put_att(fID,gamID,'units','none' ),'Zgam') 500 CALL nc(nf90_put_att(fID,theID,'units','degrees'),'Zthe') 501 CALL nc(nf90_put_att(fID,picID,'units','m' ),'Zpic') 502 CALL nc(nf90_put_att(fID,valID,'units','m' ),'Zval') 503 504 CALL nc(nf90_put_att(fID,nf90_global,'Conventions','COARDS/CF-1.0')) 505 CALL nc(nf90_put_att(fID,nf90_global,'Initial_Grid',TRIM(res_in))) 506 CALL nc(nf90_put_att(fID,nf90_global,'history',TRIM(call_seq))) 507 CALL nc(nf90_enddef(fID)) 508 509 CALL nc(nf90_put_var(fID, loID,lon_ou),'x' ) 510 CALL nc(nf90_put_var(fID, laID,lat_ou),'y' ) 511 CALL nc(nf90_put_var(fID,mskID,msko),'mask') 512 512 IF(fmsk=='noro') & 513 CALL nc( NF90_PUT_VAR(fID,phiID,Zphi),'Zphi')514 CALL nc( NF90_PUT_VAR(fID,meaID,h0 ),'Zmea')515 CALL nc( NF90_PUT_VAR(fID, muID,mu ),'mu' )516 CALL nc( NF90_PUT_VAR(fID,sigID,Zsig),'Zsig')517 CALL nc( NF90_PUT_VAR(fID,gamID,Zgam),'Zgam')518 CALL nc( NF90_PUT_VAR(fID,theID,Zthe),'Zthe')519 CALL nc( NF90_PUT_VAR(fID,picID, h0+2*mu ),'Zpic')520 CALL nc( NF90_PUT_VAR(fID,valID,MAX(0.,h0-2*mu)),'Zval')521 CALL nc( NF90_CLOSE(fID))513 CALL nc(nf90_put_var(fID,phiID,Zphi),'Zphi') 514 CALL nc(nf90_put_var(fID,meaID,h0 ),'Zmea') 515 CALL nc(nf90_put_var(fID, muID,mu ),'mu' ) 516 CALL nc(nf90_put_var(fID,sigID,Zsig),'Zsig') 517 CALL nc(nf90_put_var(fID,gamID,Zgam),'Zgam') 518 CALL nc(nf90_put_var(fID,theID,Zthe),'Zthe') 519 CALL nc(nf90_put_var(fID,picID, h0+2*mu ),'Zpic') 520 CALL nc(nf90_put_var(fID,valID,MAX(0.,h0-2*mu)),'Zval') 521 CALL nc(nf90_close(fID)) 522 522 WRITE(*,*)'Finished.' 523 523 -
LMDZ6/branches/Amaury_dev/tools/netcdf95/Datasets/nf95_create_single.f90
r5088 r5100 19 19 ! Shortcut to create a file containing a single primary variable. 20 20 21 use netcdf, only: NF90_CLOBBER, NF90_FLOAT21 use netcdf, only: nf90_clobber, nf90_float 22 22 23 23 use nf95_create_m, only: nf95_create … … 36 36 !---------------------------------------------------------------------- 37 37 38 call nf95_create(name // ".nc", NF90_CLOBBER, ncid)38 call nf95_create(name // ".nc", nf90_clobber, ncid) 39 39 40 40 do i = 1, size(coordinates) 41 41 call nf95_def_dim(ncid, coordinates(i)%name, coordinates(i)%nclen, & 42 42 dimids(i)) 43 call nf95_def_var(ncid, coordinates(i)%name, NF90_FLOAT, dimids(i), &43 call nf95_def_var(ncid, coordinates(i)%name, nf90_float, dimids(i), & 44 44 varid_coord(i)) 45 45 … … 50 50 END DO 51 51 52 call nf95_def_var(ncid, name, NF90_FLOAT, dimids, varid)52 call nf95_def_var(ncid, name, nf90_float, dimids, varid) 53 53 54 54 end subroutine nf95_create_single
Note: See TracChangeset
for help on using the changeset viewer.