! $Id: read_pstoke0.f90 5270 2024-10-24 11:55:38Z abarral $ SUBROUTINE read_pstoke0(irec, zrec, zkon, zkev, airefi, phisfi, t, mfu, mfd, & en_u, de_u, en_d, de_d, coefh, fm_therm, en_therm, frac_impa, frac_nucl, & pyu1, pyv1, ftsol, psrf) ! ****************************************************************************** ! Frederic HOURDIN, Abderrahmane IDELKADI ! Lecture des parametres physique stockes online necessaires pour ! recalculer offline le transport des traceurs sur la meme grille que ! online ! A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)! ! ****************************************************************************** USE netcdf USE dimphy USE indice_sol_mod USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev IMPLICIT NONE INTEGER kon, kev, zkon, zkev ! PARAMETER (kon=iim*(jjm-1)+2, kev=llm) REAL :: phisfi(nbp_lon*(nbp_lat-2)+2) !phisfi(kon) REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(nbp_lon, nbp_lat) REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(nbp_lon, nbp_lat) REAL :: mfu(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfu(kon, kev) REAL :: mfd(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfd(kon, kev) REAL :: en_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_u(kon, kev) REAL :: de_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_u(kon, kev) REAL :: en_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_d(kon, kev) REAL :: de_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_d(kon, kev) REAL :: coefh(nbp_lon*(nbp_lat-2)+2,nbp_lev) !coefh(kon, kev) ! abd 25 11 02 ! Thermiques REAL :: fm_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !fm_therm(kon, kev) REAL :: en_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_therm(kon, kev) REAL :: t(nbp_lon*(nbp_lat-2)+2,nbp_lev) !t(kon, kev) REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: t2(:,:,:) !t2(nbp_lon, nbp_lat, kev) ! Thermiques REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: pl(:) !pl(kev) INTEGER irec INTEGER xid, yid, zid, tid INTEGER zrec, zim, zjm INTEGER ncrec, nckon, nckev, ncim, ncjm REAL :: airefi(nbp_lon*(nbp_lat-2)+2) !airefi(kon) CHARACTER *20 namedim ! !! attention !! ! attention il y a aussi le pb de def kon ! dim de phis?? REAL :: frac_impa(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_impa(kon, kev) REAL :: frac_nucl(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_nucl(kon, kev) REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(nbp_lon, nbp_lat, kev) REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(nbp_lon, nbp_lat, kev) REAL :: pyu1(nbp_lon*(nbp_lat-2)+2) !pyu1(kon) REAL :: pyv1(nbp_lon*(nbp_lat-2)+2) !pyv1(kon) REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat) REAL :: ftsol(nbp_lon*(nbp_lat-2)+2,nbp_lev) !ftsol(kon, nbsrf) REAL :: psrf(nbp_lon*(nbp_lat-2)+2,nbp_lev) !psrf(kon, nbsrf) REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(kon), ftsol2(kon) REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(kon), ftsol4(kon) REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(kon), psrf2(kon) REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(kon), psrf4(kon) REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(nbp_lon, nbp_lat) REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(nbp_lon, nbp_lat) REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(nbp_lon, nbp_lat) REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(nbp_lon, nbp_lat) REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(nbp_lon, nbp_lat) REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(nbp_lon, nbp_lat) REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(nbp_lon, nbp_lat) REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(nbp_lon, nbp_lat) INTEGER,SAVE :: ncidp INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu INTEGER,SAVE :: varidt INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn ! therm INTEGER,SAVE :: varidfmth, varidenth INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4 INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4 INTEGER l, i INTEGER start(4), count(4), status REAL rcode LOGICAL,SAVE :: first=.TRUE. ! Allocate arrays kon=nbp_lon*(nbp_lat-2)+2 kev=nbp_lev ALLOCATE(phisfi2(nbp_lon, nbp_lat)) ALLOCATE(airefi2(nbp_lon, nbp_lat)) ALLOCATE(mfu2(nbp_lon, nbp_lat, kev)) ALLOCATE(mfd2(nbp_lon, nbp_lat, kev)) ALLOCATE(en_u2(nbp_lon, nbp_lat, kev)) ALLOCATE(de_u2(nbp_lon, nbp_lat, kev)) ALLOCATE(en_d2(nbp_lon, nbp_lat, kev)) ALLOCATE(de_d2(nbp_lon, nbp_lat, kev)) ALLOCATE(coefh2(nbp_lon, nbp_lat, kev)) ALLOCATE(t2(nbp_lon, nbp_lat, kev)) ALLOCATE(fm_therm2(nbp_lon, nbp_lat, kev)) ALLOCATE(en_therm2(nbp_lon, nbp_lat, kev)) ALLOCATE(pl(kev)) ALLOCATE(frac_impa2(nbp_lon, nbp_lat, kev)) ALLOCATE(frac_nucl2(nbp_lon, nbp_lat, kev)) ALLOCATE(pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat)) ALLOCATE(ftsol1(kon), ftsol2(kon)) ALLOCATE(ftsol3(kon), ftsol4(kon)) ALLOCATE(psrf1(kon), psrf2(kon)) ALLOCATE(psrf3(kon), psrf4(kon)) ALLOCATE(ftsol12(nbp_lon, nbp_lat)) ALLOCATE(ftsol22(nbp_lon, nbp_lat)) ALLOCATE(ftsol32(nbp_lon, nbp_lat)) ALLOCATE(ftsol42(nbp_lon, nbp_lat)) ALLOCATE(psrf12(nbp_lon, nbp_lat)) ALLOCATE(psrf22(nbp_lon, nbp_lat)) ALLOCATE(psrf32(nbp_lon, nbp_lat)) ALLOCATE(psrf42(nbp_lon, nbp_lat)) ! --------------------------------------------- ! Initialisation de la lecture des fichiers ! --------------------------------------------- IF (irec==0) THEN rcode = nf90_open('phystoke.nc', nf90_nowrite, ncidp) rcode = nf90_inq_varid(ncidp, 'phis', varidps) PRINT *, 'ncidp,varidps', ncidp, varidps rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl) PRINT *, 'ncidp,varidpl', ncidp, varidpl rcode = nf90_inq_varid(ncidp, 'aire', varidai) PRINT *, 'ncidp,varidai', ncidp, varidai rcode = nf90_inq_varid(ncidp, 't', varidt) PRINT *, 'ncidp,varidt', ncidp, varidt rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu) PRINT *, 'ncidp,varidmfu', ncidp, varidmfu rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd) PRINT *, 'ncidp,varidmfd', ncidp, varidmfd rcode = nf90_inq_varid(ncidp, 'en_u', varidenu) PRINT *, 'ncidp,varidenu', ncidp, varidenu rcode = nf90_inq_varid(ncidp, 'de_u', variddeu) PRINT *, 'ncidp,variddeu', ncidp, variddeu rcode = nf90_inq_varid(ncidp, 'en_d', varidend) PRINT *, 'ncidp,varidend', ncidp, varidend rcode = nf90_inq_varid(ncidp, 'de_d', varidded) PRINT *, 'ncidp,varidded', ncidp, varidded rcode = nf90_inq_varid(ncidp, 'coefh', varidch) PRINT *, 'ncidp,varidch', ncidp, varidch ! Thermiques rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth) PRINT *, 'ncidp,varidfmth', ncidp, varidfmth rcode = nf90_inq_varid(ncidp, 'en_th', varidenth) PRINT *, 'ncidp,varidenth', ncidp, varidenth rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi) PRINT *, 'ncidp,varidfi', ncidp, varidfi rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn) PRINT *, 'ncidp,varidfn', ncidp, varidfn rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1) PRINT *, 'ncidp,varidyu1', ncidp, varidyu1 rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1) PRINT *, 'ncidp,varidyv1', ncidp, varidyv1 rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1) PRINT *, 'ncidp,varidfts1', ncidp, varidfts1 rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2) PRINT *, 'ncidp,varidfts2', ncidp, varidfts2 rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3) PRINT *, 'ncidp,varidfts3', ncidp, varidfts3 rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4) PRINT *, 'ncidp,varidfts4', ncidp, varidfts4 rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1) PRINT *, 'ncidp,varidpsr1', ncidp, varidpsr1 rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2) PRINT *, 'ncidp,varidpsr2', ncidp, varidpsr2 rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3) PRINT *, 'ncidp,varidpsr3', ncidp, varidpsr3 rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4) PRINT *, 'ncidp,varidpsr4', ncidp, varidpsr4 ! ID pour les dimensions status = nf90_inq_dimid(ncidp, 'y', yid) status = nf90_inq_dimid(ncidp, 'x', xid) status = nf90_inq_dimid(ncidp, 'sig_s', zid) status = nf90_inq_dimid(ncidp, 'time_counter', tid) ! lecture des dimensions status = nf90_inquire_dimension(ncidp, yid, namedim, ncjm) status = nf90_inquire_dimension(ncidp, xid, namedim, ncim) status = nf90_inquire_dimension(ncidp, zid, namedim, nckev) status = nf90_inquire_dimension(ncidp, tid, namedim, ncrec) zrec = ncrec zkev = nckev zim = ncim zjm = ncjm zkon = zim*(zjm-2) + 2 WRITE (*, *) 'read_pstoke : zrec = ', zrec WRITE (*, *) 'read_pstoke : kev = ', zkev WRITE (*, *) 'read_pstoke : zim = ', zim WRITE (*, *) 'read_pstoke : zjm = ', zjm WRITE (*, *) 'read_pstoke : kon = ', zkon ! niveaux de pression status = nf90_get_var(ncidp, varidpl, pl, [1], [kev]) ! lecture de aire et phis start(1) = 1 start(2) = 1 start(3) = 1 start(4) = 0 count(1) = zim count(2) = zjm count(3) = 1 count(4) = 0 ! **** Geopotentiel au sol *************************************** ! phis status = nf90_get_var(ncidp, varidps, phisfi2, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi) ! **** Aires des mails aux sol ************************************ ! aire status = nf90_get_var(ncidp, varidai, airefi2, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, airefi2, airefi) ELSE PRINT *, 'ok1' ! --------------------- ! lecture des champs ! --------------------- PRINT *, 'WARNING!!! Il n y a pas de test de coherence' PRINT *, 'sur le nombre de niveaux verticaux dans le fichier nc' start(1) = 1 start(2) = 1 start(3) = 1 start(4) = irec count(1) = zim count(2) = zjm count(3) = kev count(4) = 1 ! **** Temperature ******************************************** ! A FAIRE : Es-ce necessaire ? ! abder t status = nf90_get_var(ncidp, varidt, t2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t) ! **** Flux pour la convection (Tiedtk) ! ******************************************** ! mfu status = nf90_get_var(ncidp, varidmfu, mfu2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu) ! mfd status = nf90_get_var(ncidp, varidmfd, mfd2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd) ! en_u status = nf90_get_var(ncidp, varidenu, en_u2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u) ! de_u status = nf90_get_var(ncidp, variddeu, de_u2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u) ! en_d status = nf90_get_var(ncidp, varidend, en_d2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d) ! de_d status = nf90_get_var(ncidp, varidded, de_d2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d) ! **** Coefficient de mellange turbulent ! ******************************************* ! coefh PRINT *, 'LECTURE de coefh a irec =', irec status = nf90_get_var(ncidp, varidch, coefh2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh) ! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ ') ! call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ ') ! **** Flux ascendants et entrant dans le thermique ! ********************************** ! Thermiques PRINT *, 'LECTURE de fm_therm a irec =', irec status = nf90_get_var(ncidp, varidfmth, fm_therm2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm) PRINT *, 'LECTURE de en_therm a irec =', irec status = nf90_get_var(ncidp, varidenth, en_therm2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm) ! **** Coefficients de lessivage ! ******************************************* ! frac_impa status = nf90_get_var(ncidp, varidfi, frac_impa2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa) ! frac_nucl status = nf90_get_var(ncidp, varidfn, frac_nucl2, start, count) CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl) ! **** Vents aux sol ******************************************** start(3) = irec start(4) = 0 count(3) = 1 count(4) = 0 ! pyu1 PRINT *, 'LECTURE de yu1 a irec =', irec status = nf90_get_var(ncidp, varidyu1, pyu12, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1) ! pyv1 PRINT *, 'LECTURE de yv1 a irec =', irec status = nf90_get_var(ncidp, varidyv1, pyv12, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1) ! **** Temerature au sol ******************************************** ! ftsol1 PRINT *, 'LECTURE de ftsol1 a irec =', irec status = nf90_get_var(ncidp, varidfts1, ftsol12, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1) ! ftsol2 PRINT *, 'LECTURE de ftsol2 a irec =', irec status = nf90_get_var(ncidp, varidfts2, ftsol22, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2) ! ftsol3 PRINT *, 'LECTURE de ftsol3 a irec =', irec status = nf90_get_var(ncidp, varidfts3, ftsol32, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3) ! ftsol4 status = nf90_get_var(ncidp, varidfts4, ftsol42, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4) ! **** Nature sol ******************************************** ! psrf1 status = nf90_get_var(ncidp, varidpsr1, psrf12, start, count) ! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC') CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1) ! psrf2 status = nf90_get_var(ncidp, varidpsr2, psrf22, start, count) ! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC') CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2) ! psrf3 status = nf90_get_var(ncidp, varidpsr3, psrf32, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3) ! psrf4 status = nf90_get_var(ncidp, varidpsr4, psrf42, start, count) CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4) DO i = 1, kon psrf(i, 1) = psrf1(i) psrf(i, 2) = psrf2(i) psrf(i, 3) = psrf3(i) ! test abderr ! print*,'Dans read_pstoke psrf3 =',psrf3(i),i psrf(i, 4) = psrf4(i) ftsol(i, 1) = ftsol1(i) ftsol(i, 2) = ftsol2(i) ftsol(i, 3) = ftsol3(i) ftsol(i, 4) = ftsol4(i) END DO END IF RETURN END SUBROUTINE read_pstoke0