*=*=*=*= makelim.html =*=*=*=*
PROGRAM makelim IMPLICIT none c c------------------------------------------------------------- C Author : L. Fairhead C Date : 27/01/94 C Objet : Construction des fichiers de conditions aux limites C pour le nouveau C modele a partir de fichiers de climatologie. Les deux C grilles doivent etre regulieres c c Modifie par z.x.li (le23mars1994) c------------------------------------------------------------- c #include "dimensions.h" #include "paramet.h" #include "control.h" #include "logic.h" #include "drsdef.h" #include "comvert.h" #include "comgeom2.h" #include "comconst.h" c c----------------------------------------------------------------------- INTEGER KIDIA, KFDIA, KLON, KLEV PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2, . KLON=KFDIA-KIDIA+1,KLEV=llm) c----------------------------------------------------------------------- REAL phy_nat(klon,360), phy_nat0(klon) REAL phy_alb(klon,360) REAL phy_sst(klon,360) REAL phy_bil(klon,360) REAL phy_rug(klon,360) REAL phy_ice(klon,360) c REAL masque(iip1,jjp1) REAL mask(iim,jjp1) C Declarations pour le champ de depart INTEGER imdep, jmdep,lmdep INTEGER ibid, jbid, tbid parameter (ibid = 400, ! >360 pts . jbid = 200, ! >181 pts . tbid = 60) ! >52 semaines REAL champ(ibid*jbid) REAL dlon(ibid), dlat(jbid), timecoord(tbid) c INTEGER ibid_msk, jbid_msk PARAMETER(ibid_msk=2200,jbid_msk=1100) REAL champ_msk(ibid_msk*jbid_msk) REAL dlon_msk(ibid_msk), dlat_msk(jbid_msk) C Declarations pour le champ interpole 2D REAL champint(iim,jjp1) C Declarations pour le champ interpole 3D REAL champtime(iim,jjp1,tbid) REAL timeyear(tbid) REAL champan(iip1,jjp1,366) C Declarations pour l'inteprolation verticale REAL ax(tbid), ay(tbid) REAL by REAL yder(tbid) C Declarations liees a la description des variables (setname) character varsource*120 character varname*16, vartitle*80 character varunits*40, vartype*8 character vardate*8, vartime*8 character dimsource*120 character dimname*16, dimtitle*80 character dimunits*40, dimtype*8 character*80 drsname C Declaration DRS INTEGER aslun, setname, putdat, cllun, cluvdb INTEGER inqdict, getname, getcdim INTEGER setvdim, setdim, getslab, putvdim INTEGER getdat INTEGER ierr INTEGER datadic, datadat parameter (datadic = 10, datadat = 11) INTEGER intdic, intdat PARAMETER (intdic=20, intdat=21) INTEGER ecdicdyn, ecdatdyn REAL dimfirst(3) REAL dimlast(3) REAL dimcycl(3) INTEGER dimord(3) INTEGER vardim(3) c Declarations pour les variables mises dans le fichier DRS INTEGER length parameter (length = 100) INTEGER i, j, numdim, k, l c Diverses variables locales REAL time REAL timdeb, timfin REAL fract INTEGER an, mois, jour INTEGER it1, it2 #include "serre.h" #include "fxyprim.h" c initialisations: OPEN (8,file='run.def',form='formatted') CALL defrun_new( 8, .TRUE. ) CLOSE(8) pi = 4. * atan(1.) rad=6400000. omeg=4.*asin(1.)/(24.*3600.) g=9.8 daysec=86400. c c ###### P. Le Van ( Modif le 25/1/96 ) ####### c pour avoir R = 287.059 et CP = 1004.70 , comme dans physiq.F mugaz = 28.9645 kappa = 0.285716 c dtvr = daysec/FLOAT(day_step) c call iniconst call inigeom c c C Traitement du relief au sol c PRINT*, 'Traitement du relief au sol pour fabriquer masque' ierr = ASLUN(datadic,'relief',datadat,' ',IDRS_READ) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier relief' write(6,*)' ierr = ', ierr call exit(1) endif c ierr = CLUVDB() ierr = SETNAME(' ','RELIEF',' ',' ',' ') ierr = INQDICT(datadic, IDRS_GETFIRSTVAR) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid_msk, dlon_msk, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid_msk, dlat_msk, jmdep) ierr=GETDAT(datadic,champ_msk,imdep*jmdep*IDRS_BYTES_PER_WORD) ierr = CLLUN(datadic) c CALL mask_c_o(imdep, jmdep, dlon_msk, dlat_msk,champ_msk, . iim, jjp1, rlonv, rlatu, champint) CALL gr_int_dyn(champint, masque, iim, jjp1) DO i = 1, iim masque(i,1) = FLOAT(NINT(masque(i,1))) masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1))) ENDDO DO i = 1, iim DO j = 1, jjp1 mask(i,j) = champint(i,j) ENDDO ENDDO call gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0) ierr = CLLUN(datadic) c c C Traitement de la rugosite c PRINT*, 'Traitement de la rugosite' ierr = ASLUN(datadic,'rugos',datadat,' ',IDRS_READ) IF (ierr.ne.0) THEN write(6,*)' Pb d''ouverture du fichier rugos_1x1' write(6,*)' ierr = ', ierr call exit(1) ENDIF c ierr = CLUVDB() ierr = SETNAME(' ','RUGOS',' ',' ',' ') ierr = INQDICT(datadic, IDRS_GETFIRSTVAR) ierr = GETNAME(varsource,varname,vartitle,varunits,vardate, . vartime,vartype, numdim) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) ierr = GETCDIM(3, dimsource, dimname, dimtitle, dimunits, . dimtype, tbid, timecoord, lmdep) DO l = 1, lmdep dimfirst(1) = dlon(1) dimfirst(2) = dlat(1) dimfirst(3) = timecoord(l) c dimlast(1) = dlon(imdep) dimlast(2) = dlat(jmdep) dimlast(3) = timecoord(l) c dimcycl(1) = 0. dimcycl(2) = 0. dimcycl(3) = 0. c dimord(1) = 1 dimord(2) = 2 dimord(3) = 3 c vardim(1) = imdep vardim(2) = jmdep vardim(3) = lmdep PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l) ierr = GETSLAB(datadic, 3, dimord, dimfirst, dimlast, . dimcycl, champ, vardim) CALL rugosite(imdep, jmdep, dlon, dlat, champ, . iim, jjp1, rlonv, rlatu, champint, mask) DO j = 1,jjp1 DO i = 1, iim champtime (i,j,l) = champint(i,j) ENDDO ENDDO ENDDO c DO l = 1, lmdep timeyear(l) = timecoord(l) ENDDO print*, 'timeyear=', timeyear c PRINT*, 'Interpolation temporelle dans l annee' DO j = 1, jjp1 DO i = 1, iim DO l = 1, lmdep ax(l) = timeyear(l) ay(l) = champtime (i,j,l) ENDDO CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) DO k = 1, 360 time = FLOAT(k-1) CALL SPLINT(ax,ay,yder,lmdep,time,by) champan(i,j,k) = by ENDDO ENDDO ENDDO DO k = 1, 360 DO j = 1, jjp1 champan(iip1,j,k) = champan(1,j,k) ENDDO ENDDO c DO k = 1, 360 CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k)) ENDDO c ierr = CLLUN(datadic) c c C Traitement de la glace oceanique c PRINT*, 'Traitement de la glace oceanique' ierr = ASLUN(datadic,'amip',datadat,' ',IDRS_READ) IF (ierr.ne.0) THEN write(6,*)' Pb d''ouverture du fichier amip' write(6,*)' ierr = ', ierr call exit(1) ENDIF c ierr = CLUVDB() ierr = SETNAME(' ','SEA_ICE',' ',' ',' ') ierr = INQDICT(datadic, IDRS_GETFIRSTVAR) ierr = GETNAME(varsource,varname,vartitle,varunits,vardate, . vartime,vartype, numdim) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) ierr = GETCDIM(3, dimsource, dimname, dimtitle, dimunits, . dimtype, tbid, timecoord, lmdep) DO l = 1, lmdep dimfirst(1) = dlon(1) dimfirst(2) = dlat(1) dimfirst(3) = timecoord(l) c dimlast(1) = dlon(imdep) dimlast(2) = dlat(jmdep) dimlast(3) = timecoord(l) c dimcycl(1) = 0. dimcycl(2) = 0. dimcycl(3) = 0. c dimord(1) = 1 dimord(2) = 2 dimord(3) = 3 c vardim(1) = imdep vardim(2) = jmdep vardim(3) = lmdep PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l) ierr = GETSLAB(datadic, 3, dimord, dimfirst, dimlast, . dimcycl, champ, vardim) CALL sea_ice(imdep, jmdep, dlon, dlat, champ, . iim, jjp1, rlonv, rlatu, champint) DO j = 1,jjp1 DO i = 1, iim champtime (i,j,l) = champint(i,j) ENDDO ENDDO ENDDO c DO l = 1, lmdep timeyear(l) = timecoord(l) ENDDO PRINT*, 'timeyear=', timeyear c PRINT*, 'Interpolation temporelle' DO j = 1, jjp1 DO i = 1, iim DO l = 1, lmdep ax(l) = timeyear(l) ay(l) = champtime (i,j,l) ENDDO CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) DO k = 1, 360 time = FLOAT(k-1) CALL SPLINT(ax,ay,yder,lmdep,time,by) champan(i,j,k) = by ENDDO ENDDO ENDDO DO k = 1, 360 DO j = 1, jjp1 champan(iip1, j, k) = champan(1, j, k) ENDDO ENDDO c c c .... Modif P.Le Van ( 1/09/95 ) ... c DO k = 1, 360 CALL gr_dyn_fi(1, iip1, jjp1, klon, . champan(1,1,k), phy_ice(1,k)) DO i = 1, klon phy_nat(i,k) = phy_nat0(i) IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN IF (NINT(phy_nat0(i)).EQ.0) THEN phy_nat(i,k) = 3.0 ELSE phy_nat(i,k) = 2.0 ENDIF ENDIF ENDDO ENDDO c ierr = CLLUN(datadic) c c C Traitement de la sst c PRINT*, 'Traitement de la sst' ierr = ASLUN(datadic,'amip',datadat,' ',IDRS_READ) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier amip' write(6,*)' ierr = ', ierr call exit(1) endif c ierr = CLUVDB() ierr = SETNAME(' ','SST',' ',' ',' ') ierr = INQDICT(datadic, IDRS_GETFIRSTVAR) ierr = GETNAME(varsource,varname,vartitle,varunits,vardate, . vartime,vartype, numdim) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) ierr = GETCDIM(3, dimsource, dimname, dimtitle, dimunits, . dimtype, tbid, timecoord, lmdep) do l = 1, lmdep dimfirst(1) = dlon(1) dimfirst(2) = dlat(1) dimfirst(3) = timecoord(l) c dimlast(1) = dlon(imdep) dimlast(2) = dlat(jmdep) dimlast(3) = timecoord(l) c dimcycl(1) = 0. dimcycl(2) = 0. dimcycl(3) = 0. c dimord(1) = 1 dimord(2) = 2 dimord(3) = 3 c vardim(1) = imdep vardim(2) = jmdep vardim(3) = lmdep PRINT*,'Lecture temporelle et int. horizontale',l,timecoord(l) ierr = GETSLAB(datadic, 3, dimord, dimfirst, dimlast, . dimcycl, champ, vardim) CALL grille_m(imdep, jmdep, dlon, dlat, champ, . iim, jjp1, rlonv, rlatu, champint) DO j = 1,jjp1 DO i = 1, iim champtime (i,j,l) = champint(i,j) ENDDO ENDDO ENDDO c DO l = 1, lmdep timeyear(l) = timecoord(l) ENDDO print*, 'timeyear=', timeyear c C interpolation temporelle DO j = 1, jjp1 DO i = 1, iim DO l = 1, lmdep ax(l) = timeyear(l) ay(l) = champtime (i,j,l) ENDDO CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) DO k = 1, 360 time = FLOAT(k-1) CALL SPLINT(ax,ay,yder,lmdep,time,by) champan(i,j,k) = by ENDDO ENDDO ENDDO DO k = 1, 360 DO j = 1, jjp1 champan(iip1,j,k) = champan(1,j,k) ENDDO ENDDO c DO k = 1, 360 CALL gr_dyn_fi(1, iip1, jjp1, klon, . champan(1,1,k), phy_sst(1,k)) ENDDO c ierr = CLLUN(datadic) c c C Traitement de l'albedo c PRINT*, 'Traitement de l albedo' ierr = ASLUN(datadic,'albed',datadat,' ',IDRS_READ) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier albed' write(6,*)' ierr = ', ierr call exit(1) endif c ierr = cluvdb() ierr = SETNAME(' ','ALBEDO',' ',' ',' ') ierr = INQDICT(datadic, IDRS_GETFIRSTVAR) ierr = GETNAME(varsource,varname,vartitle,varunits,vardate, . vartime,vartype, numdim) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) ierr = GETCDIM(3, dimsource, dimname, dimtitle, dimunits, . dimtype, tbid, timecoord, lmdep) DO l = 1, lmdep dimfirst(1) = dlon(1) dimfirst(2) = dlat(1) dimfirst(3) = timecoord(l) c dimlast (1) = dlon(imdep) dimlast (2) = dlat(jmdep) dimlast(3) = timecoord(l) c dimcycl (1) = 0. dimcycl(2) = 0. dimcycl(3) = 0. c dimord(1) = 1 dimord(2) = 2 dimord(3) = 3 c vardim(1) = imdep vardim(2) = jmdep vardim(3) = lmdep PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l) ierr = GETSLAB(datadic, 3, dimord, dimfirst, dimlast, . dimcycl, champ, vardim) CALL grille_m(imdep, jmdep, dlon, dlat, champ, . iim, jjp1, rlonv, rlatu, champint) c DO j = 1,jjp1 DO i = 1, iim champtime (i, j, l) = champint(i, j) ENDDO ENDDO ENDDO c DO l = 1, lmdep timeyear(l) = timecoord(l) ENDDO print*, 'timeyear=', timeyear c C interpolation temporelle DO j = 1, jjp1 DO i = 1, iim DO l = 1, lmdep ax(l) = timeyear(l) ay(l) = champtime (i, j, l) ENDDO call SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) DO k = 1, 360 time = FLOAT(k-1) call SPLINT(ax,ay,yder,lmdep,time,by) champan(i,j,k) = by ENDDO ENDDO ENDDO DO k = 1, 360 DO j = 1, jjp1 champan(iip1, j, k) = champan(1, j, k) ENDDO ENDDO c DO k = 1, 360 call gr_dyn_fi(1, iip1, jjp1, klon, . champan(1,1,k), phy_alb(1,k)) ENDDO c ierr = CLLUN(datadic) c c c c PRINT*, 'Ecriture du fichier limit' ierr = ASLUN(intdic,'limit',intdat,' ',IDRS_CREATE) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier' write(6,*)' ierr = ', ierr CALL ABORT endif c ierr = CLUVDB() ierr = SETNAME(' ', 'NAT', 'nature_sol', ' ', ' ') ierr = SETDIM(1, 'points_physiques', ' ', . klon, 1.0, float(klon)) ierr = SETDIM(2, 'jours_dans_l_annee', ' ', . 360, 0.0, 359.0) ierr = PUTDAT(intdic, phy_nat) c ierr = CLUVDB() ierr = SETNAME(' ', 'SST', 'temperature', 'Kelvin', ' ') ierr = SETDIM(1, 'points_physiques', ' ', . klon, 1.0, float(klon)) ierr = SETDIM(2, 'jours_dans_l_annee', ' ', . 360, 0.0, 359.0) ierr = PUTDAT(intdic, phy_sst) c DO k = 1, 360 DO i = 1, klon phy_bil(i,k) = 0.0 ENDDO ENDDO ierr = CLUVDB() ierr = SETNAME(' ', 'BILS', 'bilan au sol', 'W/m**2', ' ') ierr = SETDIM(1, 'points_physiques', ' ', . klon, 1.0, float(klon)) ierr = SETDIM(2, 'jours_dans_l_annee', ' ', . 360, 0.0, 359.0) ierr = PUTDAT(intdic, phy_bil) c ierr = CLUVDB() ierr = SETNAME(' ', 'ALB', 'albedo', ' ', ' ') ierr = SETDIM(1, 'points_physiques', ' ', . klon, 1.0, float(klon)) ierr = SETDIM(2, 'jours_dans_l_annee', ' ', . 360, 0.0, 359.0) ierr = PUTDAT(intdic, phy_alb) c ierr = CLUVDB() ierr = SETNAME(' ', 'RUG', 'rugosite', ' ', ' ') ierr = SETDIM(1, 'points_physiques', ' ', . klon, 1.0, float(klon)) ierr = SETDIM(2, 'jours_dans_l_annee', ' ', . 360, 0.0, 359.0) ierr = PUTDAT(intdic, phy_rug) c ierr = CLLUN(intdic) c STOP END