!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Interface pour ecrire en netcdf avec les routines d'enseignement ! iotd de Frederic Hourdin !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE iophys_ecrit(nom, lllm, titre, unite, px) USE lmdz_phys_para, ONLY: klon_omp, is_mpi_root USE lmdz_phys_transfert_para, ONLY: gather USE lmdz_grid_phy, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dto2d_glo USE lmdz_iotd, ONLY: iotd_ecrit IMPLICIT NONE ! Ecriture de variables diagnostiques au choix dans la physique ! dans un fichier NetCDF nomme 'diagfi'. Ces variables peuvent etre ! 3d (ex : temperature), 2d (ex : temperature de surface), ou ! 0d (pour un scalaire qui ne depend que du temps : ex : la longitude ! solaire) ! (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne) ! La periode d'ecriture est donnee par ! "ecritphy " regle dans le fichier de controle de run : run.def ! writediagfi peut etre appele de n'importe quelle subroutine ! de la physique, plusieurs fois. L'initialisation et la creation du ! fichier se fait au tout premier appel. ! WARNING : les variables dynamique (u,v,t,q,ps) ! sauvees par writediagfi avec une ! date donnee sont legerement differentes que dans le fichier histoire car ! on ne leur a pas encore ajoute de la dissipation et de la physique !!! ! IL est RECOMMANDE d'ajouter les tendance physique a ces variables ! avant l'ecriture dans diagfi (cf. physiq.F) ! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4 ! parametres (input) : ! ---------- ! unit : unite logique du fichier de sortie (toujours la meme) ! nom : nom de la variable a sortir (chaine de caracteres) ! titre: titre de la variable (chaine de caracteres) ! unite : unite de la variable (chaine de caracteres) ! px : variable a sortir (real 0, 1, 2, ou 3d) !================================================================= ! Arguments on input: INTEGER lllm CHARACTER (LEN = *) :: nom, titre, unite INTEGER imjmax parameter (imjmax = 100000) REAL px(klon_omp, lllm) REAL xglo(klon_glo, lllm) REAL zx(nbp_lon, nbp_lat, lllm) CALL Gather(px, xglo) !$OMP MASTER IF (is_mpi_root) THEN CALL Grid1Dto2D_glo(xglo, zx) CALL iotd_ecrit(nom, lllm, titre, unite, zx) ENDIF !$OMP END MASTER RETURN end !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Version avec reindexation pour appeler depuis les routines internes ! à la sous surface !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE iophys_ecrit_index(nom, lllm, titre, unite, knon, knindex, px) USE lmdz_phys_para, ONLY: klon_omp USE dimphy, ONLY: klon USE lmdz_grid_phy, ONLY: klon_glo USE lmdz_abort_physic, ONLY: abort_physic IMPLICIT NONE ! This SUBROUTINE returns the sea surface temperature already read from limit.nc ! Arguments on input: INTEGER lllm CHARACTER (len = *) :: nom, titre, unite REAL px(klon_omp, lllm) INTEGER, INTENT(IN) :: knon ! nomber of points on compressed grid INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! grid point number for compressed grid REAL, DIMENSION(klon, lllm) :: varout INTEGER :: i, l IF (klon/=klon_omp) THEN PRINT*, 'klon, klon_omp', klon, klon_omp CALL abort_physic('iophys_ecrit', 'probleme de dimension parallele', 1) ENDIF varout(1:klon, 1:lllm) = 0. DO l = 1, lllm DO i = 1, knon varout(knindex(i), l) = px(i, l) END DO END DO CALL iophys_ecrit(nom, lllm, titre, unite, varout) END SUBROUTINE iophys_ecrit_index !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE iophys_ini(timestep) USE lmdz_phys_para, ONLY: is_mpi_root USE lmdz_vertical_layers, ONLY: presnivs USE lmdz_regular_lonlat, ONLY: lon_reg, lat_reg USE dimphy, ONLY: klev USE lmdz_grid_phy, ONLY: klon_glo USE time_phylmdz_mod, ONLY: annee_ref, day_ref, day_ini USE phys_cal_mod, ONLY: calend USE lmdz_iotd, ONLY: iotd_ini USE lmdz_yomcst IMPLICIT NONE !======================================================================= ! Auteur: L. Fairhead , P. Le Van, Y. Wanherdrick, F. Forget ! ------- ! Objet: ! ------ ! 'Initialize' the diagfi.nc file: write down dimensions as well ! as time-independent fields (e.g: geopotential, mesh area, ...) !======================================================================= !----------------------------------------------------------------------- ! Declarations: ! ------------- REAL pi INTEGER nlat_eff INTEGER jour0, mois0, an0 REAL timestep, t0 CHARACTER(len = 20) :: calendrier ! Arguments: ! ---------- !$OMP MASTER IF (is_mpi_root) THEN ! Bidouille pour gerer le fait que lat_reg contient deux latitudes ! en version uni-dimensionnelle (chose qui pourrait être résolue ! par ailleurs) IF (klon_glo==1) THEN nlat_eff = 1 ELSE nlat_eff = size(lat_reg) ENDIF pi = 2. * asin(1.) ! PRINT*,'day_ini,annee_ref,day_ref',day_ini,annee_ref,day_ref ! PRINT*,'jD_ref,jH_ref,start_time, calend',jD_ref,jH_ref,start_time, calend ! Attention : les lignes ci dessous supposent un calendrier en 360 jours ! Pourrait être retravaillé jour0 = day_ref - 30 * (day_ref / 30) mois0 = day_ref / 30 + 1 an0 = annee_ref !FH BIZARE QUAND 1D ... t0=(day_ini-1)*RDAY t0 = 0. calendrier = calend IF (calendrier == "earth_360d") calendrier = "360_day" PRINT*, 'iophys_ini annee_ref day_ref', annee_ref, day_ref, day_ini, calend, t0 CALL iotd_ini('phys.nc', & size(lon_reg), nlat_eff, klev, lon_reg(:) * 180. / pi, lat_reg * 180. / pi, presnivs, jour0, mois0, an0, t0, timestep, calendrier) ENDIF !$OMP END MASTER END #ifdef und SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit) IMPLICIT NONE !======================================================================= INTEGER nfield,nlon,iim,jjmp1, jjm REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield) INTEGER i, n, ig jjm = jjmp1 - 1 DO n = 1, nfield DO i=1,iim ecrit(i,n) = fi(1,n) ecrit(i+jjm*iim,n) = fi(nlon,n) ENDDO DO ig = 1, nlon - 2 ecrit(iim+ig,n) = fi(1+ig,n) ENDDO ENDDO RETURN END #endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Interface pour ecrire en netcdf avec les routines d'enseignement ! iotd de Frederic Hourdin !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE iotd_ecrit_seq(nom, lllm, titre, unite, px) USE lmdz_iotd, ONLY: iotd_ecrit, imax, jmax IMPLICIT NONE ! Arguments on input: INTEGER lllm CHARACTER (LEN = *) :: nom, titre, unite INTEGER imjmax parameter (imjmax = 100000) REAL px(imjmax * lllm) REAL, ALLOCATABLE :: zx(:, :, :) INTEGER i, j, l, ijl allocate(zx(imax, jmax, lllm)) ijl = 0 do l = 1, lllm ! Pole nord ijl = ijl + 1 do i = 1, imax zx(i, 1, l) = px(ijl) enddo ! Grille normale do j = 2, jmax - 1 do i = 1, imax ijl = ijl + 1 zx(i, j, l) = px(ijl) enddo enddo ! Pole sud IF (jmax > 1) THEN ijl = ijl + 1 do i = 1, imax zx(i, jmax, l) = px(ijl) enddo endif enddo CALL iotd_ecrit(nom, lllm, titre, unite, zx) deallocate(zx) RETURN END