Changeset 5249 for LMDZ6/trunk
- Timestamp:
- Oct 22, 2024, 11:35:08 AM (2 months ago)
- Location:
- LMDZ6/trunk/libf
- Files:
-
- 16 edited
- 1 copied
-
dyn3d/dynredem_mod.F90 (modified) (1 diff)
-
dyn3d/guide_mod.F90 (modified) (3 diffs)
-
dyn3dmem/dynredem_mod.F90 (modified) (2 diffs)
-
dyn3dmem/guide_loc_mod.F90 (modified) (98 diffs)
-
dynphy_lonlat/phylmd/limit_netcdf.F90 (modified) (2 diffs)
-
misc/lmdz_cppkeys_wrapper.F90 (copied) (copied from LMDZ6/branches/Amaury_dev/libf/misc/lmdz_cppkeys_wrapper.F90) (1 diff)
-
phylmd/Dust/read_dust.F90 (modified) (2 diffs)
-
phylmd/Dust/read_surface.F90 (modified) (2 diffs)
-
phylmd/Dust/read_vent.F90 (modified) (1 diff)
-
phylmd/condsurf.F90 (modified) (2 diffs)
-
phylmd/dyn1d/mod_1D_amma_read.F90 (modified) (13 diffs)
-
phylmd/dyn1d/mod_1D_cases_read.F90 (modified) (40 diffs)
-
phylmd/interfoce_lim.F90 (modified) (7 diffs)
-
phylmd/iostart.F90 (modified) (4 diffs)
-
phylmd/phyaqua_mod.F90 (modified) (12 diffs)
-
phylmd/read_pstoke0.F90 (modified) (8 diffs)
-
phylmdiso/phyaqua_mod.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/dynredem_mod.F90
r5084 r5249 92 92 ! 93 93 SUBROUTINE cre_var(ncid,var,title,did,units) 94 ! 95 !=============================================================================== 96 IMPLICIT NONE 97 !=============================================================================== 98 ! Arguments: 94 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 95 IMPLICIT NONE 96 99 97 INTEGER, INTENT(IN) :: ncid 100 98 CHARACTER(LEN=*), INTENT(IN) :: var, title 101 99 INTEGER, INTENT(IN) :: did(:) 102 100 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units 103 !=============================================================================== 104 #ifdef NC_DOUBLE 105 CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var) 106 #else 107 CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var) 108 #endif 101 102 CALL err(NF90_DEF_VAR(ncid,var,nf90_format,did,nvarid),"inq",var) 109 103 IF(title/="") CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var) 110 104 IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var) 111 112 105 END SUBROUTINE cre_var 113 106 ! -
LMDZ6/trunk/libf/dyn3d/guide_mod.F90
r5084 r5249 1654 1654 USE comvert_mod, ONLY: presnivs 1655 1655 use netcdf95, only: nf95_def_var, nf95_put_var 1656 use netcdf, only: nf90_float, nf90_def_var 1656 use netcdf, only: nf90_float, nf90_def_var, nf90_put_var 1657 1657 1658 1658 IMPLICIT NONE … … 1713 1713 1714 1714 ! Enregistrement des variables dimensions 1715 #ifdef NC_DOUBLE 1716 ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi) 1717 ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi) 1718 ierr = NF_PUT_VAR_DOUBLE(nid,vid_latu,rlatu*180./pi) 1719 ierr = NF_PUT_VAR_DOUBLE(nid,vid_latv,rlatv*180./pi) 1720 ierr = NF_PUT_VAR_DOUBLE(nid,vid_lev,presnivs) 1721 ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu) 1722 ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv) 1723 ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u) 1724 ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v) 1725 #else 1726 ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi) 1727 ierr = NF_PUT_VAR_REAL(nid,vid_lonv,rlonv*180./pi) 1728 ierr = NF_PUT_VAR_REAL(nid,vid_latu,rlatu*180./pi) 1729 ierr = NF_PUT_VAR_REAL(nid,vid_latv,rlatv*180./pi) 1730 ierr = NF_PUT_VAR_REAL(nid,vid_lev,presnivs) 1731 ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu) 1732 ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv) 1733 ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u) 1734 ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v) 1735 #endif 1715 1716 ierr = nf90_put_var(nid, vid_lonu, rlonu * 180. / pi) 1717 ierr = nf90_put_var(nid, vid_lonv, rlonv * 180. / pi) 1718 ierr = nf90_put_var(nid, vid_latu, rlatu * 180. / pi) 1719 ierr = nf90_put_var(nid, vid_latv, rlatv * 180. / pi) 1720 ierr = nf90_put_var(nid, vid_lev, presnivs) 1721 ierr = nf90_put_var(nid, vid_cu, cu) 1722 ierr = nf90_put_var(nid, vid_cv, cv) 1723 ierr = nf90_put_var(nid, vid_au, alpha_u) 1724 ierr = nf90_put_var(nid, vid_av, alpha_v) 1725 1726 1736 1727 call nf95_put_var(nid, varid_alpha_t, alpha_t) 1737 1728 call nf95_put_var(nid, varid_alpha_q, alpha_q) … … 1808 1799 1809 1800 1810 #ifdef NC_DOUBLE 1811 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2) 1812 #else 1813 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2) 1814 #endif 1815 1801 ierr = nf90_put_var(nid, varid, field2, start, count) 1816 1802 ierr = NF_CLOSE(nid) 1817 1803 -
LMDZ6/trunk/libf/dyn3dmem/dynredem_mod.F90
r5084 r5249 170 170 ! 171 171 SUBROUTINE cre_var(ncid,var,title,did,units) 172 ! 173 !=============================================================================== 172 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 174 173 IMPLICIT NONE 175 174 !=============================================================================== … … 180 179 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units 181 180 !=============================================================================== 182 #ifdef NC_DOUBLE 183 CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var) 184 #else 185 CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var) 186 #endif 181 CALL err(NF90_DEF_VAR(ncid,var,nf90_format ,did,nvarid),"inq",var) 187 182 IF(title/="") CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var) 188 183 IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var) -
LMDZ6/trunk/libf/dyn3dmem/guide_loc_mod.F90
r5084 r5249 19 19 20 20 ! --------------------------------------------- 21 ! Declarations des cles logiques et parametres 21 ! Declarations des cles logiques et parametres 22 22 ! --------------------------------------------- 23 23 INTEGER, PRIVATE, SAVE :: iguide_read,iguide_int,iguide_sav 24 24 INTEGER, PRIVATE, SAVE :: nlevnc, guide_plevs 25 25 LOGICAL, PRIVATE, SAVE :: guide_u,guide_v,guide_T,guide_Q,guide_P 26 LOGICAL, PRIVATE, SAVE :: guide_hr,guide_teta 27 LOGICAL, PRIVATE, SAVE :: guide_BL,guide_reg,guide_add,gamma4,guide_zon 26 LOGICAL, PRIVATE, SAVE :: guide_hr,guide_teta 27 LOGICAL, PRIVATE, SAVE :: guide_BL,guide_reg,guide_add,gamma4,guide_zon 28 28 LOGICAL, PRIVATE, SAVE :: invert_p,invert_y,ini_anal 29 29 LOGICAL, PRIVATE, SAVE :: guide_2D,guide_sav,guide_modele 30 30 !FC 31 31 LOGICAL, PRIVATE, SAVE :: convert_Pa 32 32 33 33 REAL, PRIVATE, SAVE :: tau_min_u,tau_max_u 34 34 REAL, PRIVATE, SAVE :: tau_min_v,tau_max_v … … 43 43 REAL, PRIVATE, SAVE :: plim_guide_BL 44 44 45 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_u,alpha_v 46 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_T,alpha_Q 45 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_u,alpha_v 46 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_T,alpha_Q 47 47 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_P,alpha_pcor 48 48 49 49 ! --------------------------------------------- 50 50 ! Variables de guidage … … 64 64 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: qgui1,qgui2 65 65 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: psgui1,psgui2 66 66 67 67 INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev !,ijnu,ijnv 68 68 INTEGER,SAVE,PRIVATE :: jjbu,jjbv,jjeu,jjev,jjnu,jjnv … … 78 78 79 79 IMPLICIT NONE 80 80 81 81 INCLUDE "dimensions.h" 82 82 INCLUDE "paramet.h" … … 89 89 90 90 ! --------------------------------------------- 91 ! Lecture des parametres: 91 ! Lecture des parametres: 92 92 ! --------------------------------------------- 93 93 call ini_getparam("nudging_parameters_out.txt") … … 168 168 169 169 call fin_getparam 170 170 171 171 ! --------------------------------------------- 172 172 ! Determination du nombre de niveaux verticaux … … 198 198 CALL abort_gcm(modname,abort_message,1) 199 199 endif 200 200 201 201 endif 202 202 … … 211 211 endif 212 212 213 213 214 214 elseif (guide_T) then 215 215 if (ncidpl.eq.-99) then … … 233 233 234 234 235 endif 235 endif 236 236 error=NF_INQ_DIMID(ncidpl,'LEVEL',rid) 237 237 IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid) … … 268 268 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) 269 269 alpha_u=0.;alpha_v=0;alpha_T=0;alpha_Q=0;alpha_P=0 270 270 271 271 IF (guide_u) THEN 272 272 ALLOCATE(unat1(iip1,jjb_u:jje_u,nlevnc), stat = error) … … 292 292 tnat1=0.;tnat2=0.;tgui1=0.;tgui2=0. 293 293 ENDIF 294 294 295 295 IF (guide_Q) THEN 296 296 ALLOCATE(qnat1(iip1,jjb_u:jje_u,nlevnc), stat = error) … … 366 366 USE comconst_mod, ONLY: cpp, daysec, dtvr, kappa 367 367 USE comvert_mod, ONLY: ap, bp, preff, presnivs, pressure_exner 368 368 369 369 IMPLICIT NONE 370 370 371 371 INCLUDE "dimensions.h" 372 372 INCLUDE "paramet.h" … … 386 386 ! Variables pour fonction Exner (P milieu couche) 387 387 REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: pk 388 REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: pks 388 REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: pks 389 389 REAL :: unskap 390 390 REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: p ! besoin si guide_P … … 396 396 REAL, SAVE :: factt ! pas de temps en fraction de jour 397 397 !$OMP THREADPRIVATE(factt) 398 398 399 399 INTEGER :: i,j,l 400 400 CHARACTER(LEN=20) :: modname="guide_main" 401 402 !$OMP MASTER 401 402 !$OMP MASTER 403 403 ijbu=ij_begin ; ijeu=ij_end 404 jjbu=jj_begin ; jjeu=jj_end ; jjnu=jjeu-jjbu+1 404 jjbu=jj_begin ; jjeu=jj_end ; jjnu=jjeu-jjbu+1 405 405 ijbv=ij_begin ; ijev=ij_end 406 jjbv=jj_begin ; jjev=jj_end ; jjnv=jjev-jjbv+1 406 jjbv=jj_begin ; jjev=jj_end ; jjnv=jjev-jjbv+1 407 407 IF (pole_sud) THEN 408 408 ijeu=ij_end-iip1 409 409 ijev=ij_end-iip1 410 410 jjev=jj_end-1 411 jjnv=jjev-jjbv+1 411 jjnv=jjev-jjbv+1 412 412 ENDIF 413 413 IF (pole_nord) THEN … … 417 417 !$OMP END MASTER 418 418 !$OMP BARRIER 419 419 420 420 ! PRINT *,'---> on rentre dans guide_main' 421 421 ! CALL AllGather_Field(ucov,ip1jmp1,llm) … … 424 424 ! CALL AllGather_Field(ps,ip1jmp1,1) 425 425 ! CALL AllGather_Field(q,ip1jmp1,llm) 426 426 427 427 !----------------------------------------------------------------------- 428 428 ! Initialisations au premier passage … … 432 432 first=.FALSE. 433 433 !$OMP MASTER 434 ALLOCATE(f_addu(ijb_u:ije_u,llm) ) 435 ALLOCATE(f_addv(ijb_v:ije_v,llm) ) 436 ALLOCATE(pk(iip1,jjb_u:jje_u,llm) ) 437 ALLOCATE(pks(iip1,jjb_u:jje_u) ) 438 ALLOCATE(p(ijb_u:ije_u,llmp1) ) 439 CALL guide_init 434 ALLOCATE(f_addu(ijb_u:ije_u,llm) ) 435 ALLOCATE(f_addv(ijb_v:ije_v,llm) ) 436 ALLOCATE(pk(iip1,jjb_u:jje_u,llm) ) 437 ALLOCATE(pks(iip1,jjb_u:jje_u) ) 438 ALLOCATE(p(ijb_u:ije_u,llmp1) ) 439 CALL guide_init 440 440 !$OMP END MASTER 441 441 !$OMP BARRIER … … 444 444 count_no_rea=0 445 445 ! Calcul des constantes de rappel 446 factt=dtvr*iperiod/daysec 446 factt=dtvr*iperiod/daysec 447 447 !$OMP MASTER 448 448 call tau2alpha(3, iip1, jjb_v, jje_v, factt, tau_min_v, tau_max_v, alpha_v) … … 461 461 !$OMP END MASTER 462 462 !$OMP BARRIER 463 ! ini_anal: etat initial egal au guidage 463 ! ini_anal: etat initial egal au guidage 464 464 IF (ini_anal) THEN 465 465 CALL guide_interp(ps,teta) 466 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 466 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 467 467 DO l=1,llm 468 468 IF (guide_u) ucov(ijbu:ijeu,l)=ugui2(ijbu:ijeu,l) … … 471 471 IF (guide_Q) q(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l) 472 472 ENDDO 473 473 474 474 IF (guide_P) THEN 475 475 !$OMP MASTER … … 555 555 ! CALL WriteField_u('teta_guide',teta) 556 556 ! CALL WriteField_u('masse_guide',masse) 557 558 557 558 559 559 !----------------------------------------------------------------------- 560 ! Ajout des champs de guidage 560 ! Ajout des champs de guidage 561 561 !----------------------------------------------------------------------- 562 562 ! Sauvegarde du guidage? 563 f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 563 f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 564 564 IF (f_out) THEN 565 565 … … 588 588 CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.) 589 589 ENDIF 590 590 591 591 if (guide_u) then 592 592 if (guide_add) then … … 600 600 f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)-ucov(ijbu:ijeu,l) 601 601 ENDDO 602 endif 603 602 endif 603 604 604 ! CALL WriteField_u('f_addu',f_addu) 605 605 … … 632 632 f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)-teta(ijbu:ijeu,l) 633 633 ENDDO 634 endif 634 endif 635 635 if (guide_zon) CALL guide_zonave_u(2,llm,f_addu) 636 636 CALL guide_addfield_u(llm,f_addu,alpha_T) … … 653 653 !$OMP END MASTER 654 654 !$OMP BARRIER 655 endif 655 endif 656 656 if (guide_zon) CALL guide_zonave_u(2,1,f_addu(ijb_u:ije_u,1)) 657 657 CALL guide_addfield_u(1,f_addu(ijb_u:ije_u,1),alpha_P) … … 677 677 f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)-q(ijbu:ijeu,l) 678 678 ENDDO 679 endif 679 endif 680 680 if (guide_zon) CALL guide_zonave_u(2,llm,f_addu) 681 681 CALL guide_addfield_u(llm,f_addu,alpha_Q) … … 701 701 ENDDO 702 702 703 endif 704 703 endif 704 705 705 if (guide_zon) CALL guide_zonave_v(2,jjm,llm,f_addv(ijb_v:ije_v,:)) 706 706 707 707 CALL guide_addfield_v(llm,f_addv(ijb_v:ije_v,:),alpha_v) 708 708 IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt) … … 710 710 IF (f_out) THEN 711 711 ! Ehouarn: Fill in the gaps adequately 712 IF (ijbv>ijb_v) f_addv(ijb_v:ijbv-1,:)=0 712 IF (ijbv>ijb_v) f_addv(ijb_v:ijbv-1,:)=0 713 713 IF (ijev<ije_v) f_addv(ijev+1:ije_v,:)=0 714 714 CALL guide_out("vcov",jjm,llm,f_addv(ijb_v:ije_v,:)/factt,factt) … … 733 733 ! input variables 734 734 INTEGER, INTENT(IN) :: vsize 735 REAL, DIMENSION(ijb_u:ije_u), INTENT(IN) :: alpha 735 REAL, DIMENSION(ijb_u:ije_u), INTENT(IN) :: alpha 736 736 REAL, DIMENSION(ijb_u:ije_u,vsize), INTENT(INOUT) :: field 737 737 … … 756 756 ! input variables 757 757 INTEGER, INTENT(IN) :: vsize 758 REAL, DIMENSION(ijb_v:ije_v), INTENT(IN) :: alpha 758 REAL, DIMENSION(ijb_v:ije_v), INTENT(IN) :: alpha 759 759 REAL, DIMENSION(ijb_v:ije_v,vsize), INTENT(INOUT) :: field 760 760 … … 768 768 769 769 END SUBROUTINE guide_addfield_v 770 770 771 771 !======================================================================= 772 772 … … 774 774 775 775 USE comconst_mod, ONLY: pi 776 776 777 777 IMPLICIT NONE 778 778 … … 780 780 INCLUDE "paramet.h" 781 781 INCLUDE "comgeom.h" 782 782 783 783 ! input/output variables 784 784 INTEGER, INTENT(IN) :: typ … … 791 791 792 792 INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain 793 !$OMP THREADPRIVATE(imin,imax) 793 !$OMP THREADPRIVATE(imin,imax) 794 794 INTEGER :: i,j,l,ij 795 795 REAL, DIMENSION (iip1) :: lond ! longitude in Deg. … … 815 815 ENDIF 816 816 817 817 818 818 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 819 819 DO l=1,vsize … … 829 829 fieldm(j,l)=fieldm(j,l)+field(ij,l) 830 830 ENDDO 831 ENDDO 831 ENDDO 832 832 fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1) 833 833 ! Compute forcing … … 846 846 847 847 USE comconst_mod, ONLY: pi 848 848 849 849 IMPLICIT NONE 850 850 … … 852 852 INCLUDE "paramet.h" 853 853 INCLUDE "comgeom.h" 854 854 855 855 ! input/output variables 856 856 INTEGER, INTENT(IN) :: typ … … 896 896 fieldm(j,l)=fieldm(j,l)+field(ij,l) 897 897 ENDDO 898 ENDDO 898 ENDDO 899 899 fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1) 900 900 ! Compute forcing … … 909 909 910 910 END SUBROUTINE guide_zonave_v 911 911 912 912 !======================================================================= 913 913 SUBROUTINE guide_interp(psi,teta) … … 934 934 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: plunc,plsnc !niveaux pression modele 935 935 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: plvnc !niveaux pression modele 936 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: p ! pression intercouches 936 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: p ! pression intercouches 937 937 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: pls, pext ! var intermediaire 938 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: pbarx 939 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: pbary 938 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: pbarx 939 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: pbary 940 940 ! Variables pour fonction Exner (P milieu couche) 941 941 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: pk 942 REAL ,ALLOCATABLE, SAVE, DIMENSION (:,:) :: pks 942 REAL ,ALLOCATABLE, SAVE, DIMENSION (:,:) :: pks 943 943 REAL :: unskap 944 944 ! Pression de vapeur saturante 945 945 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:) :: qsat 946 946 !Variables intermediaires interpolation 947 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: zu1,zu2 947 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: zu1,zu2 948 948 REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:) :: zv1,zv2 949 949 950 950 INTEGER :: i,j,l,ij 951 951 CHARACTER(LEN=20),PARAMETER :: modname="guide_interp" 952 TYPE(Request),SAVE :: Req 952 TYPE(Request),SAVE :: Req 953 953 !$OMP THREADPRIVATE(Req) 954 954 955 955 if (is_master) write(*,*)trim(modname)//': interpolate nudging variables' 956 956 ! ----------------------------------------------------------------- … … 959 959 IF (first) THEN 960 960 !$OMP MASTER 961 ALLOCATE(plnc1(iip1,jjb_u:jje_u,nlevnc) ) 962 ALLOCATE(plnc2(iip1,jjb_u:jje_u,nlevnc) ) 963 ALLOCATE(plunc(iip1,jjb_u:jje_u,llm) ) 964 ALLOCATE(plsnc(iip1,jjb_u:jje_u,llm) ) 965 ALLOCATE(plvnc(iip1,jjb_v:jje_v,llm) ) 966 ALLOCATE(p(iip1,jjb_u:jje_u,llmp1) ) 967 ALLOCATE(pls(iip1,jjb_u:jje_u,llm) ) 968 ALLOCATE(pext(iip1,jjb_u:jje_u,llm) ) 969 ALLOCATE(pbarx(iip1,jjb_u:jje_u,llm) ) 970 ALLOCATE(pbary(iip1,jjb_v:jje_v,llm) ) 971 ALLOCATE(pk(iip1,jjb_u:jje_u,llm) ) 972 ALLOCATE(pks (iip1,jjb_u:jje_u) ) 973 ALLOCATE(qsat(ijb_u:ije_u,llm) ) 974 ALLOCATE(zu1(iip1,jjb_u:jje_u,llm) ) 975 ALLOCATE(zu2(iip1,jjb_u:jje_u,llm) ) 976 ALLOCATE(zv1(iip1,jjb_v:jje_v,llm) ) 961 ALLOCATE(plnc1(iip1,jjb_u:jje_u,nlevnc) ) 962 ALLOCATE(plnc2(iip1,jjb_u:jje_u,nlevnc) ) 963 ALLOCATE(plunc(iip1,jjb_u:jje_u,llm) ) 964 ALLOCATE(plsnc(iip1,jjb_u:jje_u,llm) ) 965 ALLOCATE(plvnc(iip1,jjb_v:jje_v,llm) ) 966 ALLOCATE(p(iip1,jjb_u:jje_u,llmp1) ) 967 ALLOCATE(pls(iip1,jjb_u:jje_u,llm) ) 968 ALLOCATE(pext(iip1,jjb_u:jje_u,llm) ) 969 ALLOCATE(pbarx(iip1,jjb_u:jje_u,llm) ) 970 ALLOCATE(pbary(iip1,jjb_v:jje_v,llm) ) 971 ALLOCATE(pk(iip1,jjb_u:jje_u,llm) ) 972 ALLOCATE(pks (iip1,jjb_u:jje_u) ) 973 ALLOCATE(qsat(ijb_u:ije_u,llm) ) 974 ALLOCATE(zu1(iip1,jjb_u:jje_u,llm) ) 975 ALLOCATE(zu2(iip1,jjb_u:jje_u,llm) ) 976 ALLOCATE(zv1(iip1,jjb_v:jje_v,llm) ) 977 977 ALLOCATE(zv2(iip1,jjb_v:jje_v,llm) ) 978 978 !$OMP END MASTER 979 979 !$OMP BARRIER 980 ENDIF 981 982 983 984 980 ENDIF 981 982 983 984 985 985 IF (guide_plevs.EQ.0) THEN 986 986 !$OMP DO … … 993 993 ENDDO 994 994 ENDDO 995 ENDIF 995 ENDIF 996 996 997 997 if (first) then … … 1006 1006 write(*,*)trim(modname)//' nudging file :' 1007 1007 SELECT CASE (guide_plevs) 1008 CASE (0) 1008 CASE (0) 1009 1009 do l=1,nlevnc 1010 1010 write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l) … … 1045 1045 1046 1046 ! ----------------------------------------------------------------- 1047 ! Calcul niveaux pression modele 1047 ! Calcul niveaux pression modele 1048 1048 ! ----------------------------------------------------------------- 1049 1049 … … 1175 1175 enddo 1176 1176 ENDIF 1177 tgui1(j*iip1,l)=tgui1((j-1)*iip1+1,l) 1178 tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l) 1177 tgui1(j*iip1,l)=tgui1((j-1)*iip1+1,l) 1178 tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l) 1179 1179 enddo 1180 1180 if (pole_nord) then … … 1186 1186 if (pole_sud) then 1187 1187 do i=1,iip1 1188 tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l) 1189 tgui2(ip1jm+i,l)=tgui2(ip1jm+1,l) 1188 tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l) 1189 tgui2(ip1jm+i,l)=tgui2(ip1jm+1,l) 1190 1190 enddo 1191 1191 endif … … 1237 1237 qgui2(ij,l)=zu2(i,j,l) 1238 1238 enddo 1239 qgui1(j*iip1,l)=qgui1((j-1)*iip1+1,l) 1240 qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l) 1239 qgui1(j*iip1,l)=qgui1((j-1)*iip1+1,l) 1240 qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l) 1241 1241 enddo 1242 1242 if (pole_nord) then … … 1248 1248 if (pole_sud) then 1249 1249 do i=1,iip1 1250 qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l) 1251 qgui2(ip1jm+i,l)=qgui2(ip1jm+1,l) 1250 qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l) 1251 qgui2(ip1jm+i,l)=qgui2(ip1jm+1,l) 1252 1252 enddo 1253 1253 endif … … 1259 1259 plsnc(:,jjbu:jjeu,l),qsat(ijbu:ijeu,l)) 1260 1260 qgui1(ijbu:ijeu,l)=qgui1(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01 !hum. rel. en % 1261 qgui2(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01 1261 qgui2(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01 1262 1262 enddo 1263 1263 … … 1296 1296 ENDDO 1297 1297 ENDIF 1298 1298 1299 1299 ! Interpolation verticale 1300 1300 !$OMP MASTER … … 1315 1315 ugui2(ij,l)=zu2(i,j,l)*cu(i,j) 1316 1316 enddo 1317 ugui1(j*iip1,l)=ugui1((j-1)*iip1+1,l) 1318 ugui2(j*iip1,l)=ugui2((j-1)*iip1+1,l) 1317 ugui1(j*iip1,l)=ugui1((j-1)*iip1+1,l) 1318 ugui2(j*iip1,l)=ugui2((j-1)*iip1+1,l) 1319 1319 enddo 1320 1320 if (pole_nord) then … … 1332 1332 enddo 1333 1333 ENDIF 1334 1334 1335 1335 IF (guide_v) THEN 1336 1336 ! Calcul des nouvelles valeurs des niveaux de pression du guidage … … 1390 1390 vgui2(ij,l)=zv2(i,j,l)*cv(i,j) 1391 1391 enddo 1392 vgui1(j*iip1,l)=vgui1((j-1)*iip1+1,l) 1393 vgui2(j*iip1,l)=vgui2((j-1)*iip1+1,l) 1392 vgui1(j*iip1,l)=vgui1((j-1)*iip1+1,l) 1393 vgui2(j*iip1,l)=vgui2((j-1)*iip1+1,l) 1394 1394 enddo 1395 1395 enddo 1396 1396 ENDIF 1397 1397 1398 1398 1399 1399 END SUBROUTINE guide_interp … … 1406 1406 use comconst_mod, only: pi 1407 1407 use serre_mod, only: clat, clon, grossismx, grossismy 1408 1408 1409 1409 implicit none 1410 1410 … … 1420 1420 REAL, INTENT(IN) :: taumin,taumax 1421 1421 ! output arguments: 1422 REAL, DIMENSION(pim,jjb:jje), INTENT(OUT) :: alpha 1423 1422 REAL, DIMENSION(pim,jjb:jje), INTENT(OUT) :: alpha 1423 1424 1424 ! local variables: 1425 1425 LOGICAL, SAVE :: first=.TRUE. … … 1506 1506 ENDIF 1507 1507 ! Premier appel: calcul des aires min et max et de gamma. 1508 IF (first) THEN 1508 IF (first) THEN 1509 1509 first=.FALSE. 1510 1510 ! coordonnees du centre du zoom 1511 CALL coordij(clon,clat,ilon,ilat) 1511 CALL coordij(clon,clat,ilon,ilat) 1512 1512 ! aire de la maille au centre du zoom 1513 1513 dxdy_min=dxdys(ilon,ilat) … … 1532 1532 endif 1533 1533 gamma=log(0.5)/log(gamma) 1534 if (gamma4) then 1534 if (gamma4) then 1535 1535 gamma=min(gamma,4.) 1536 1536 endif … … 1573 1573 !======================================================================= 1574 1574 SUBROUTINE guide_read(timestep) 1575 1575 USE netcdf, ONLY: nf90_put_var 1576 1576 IMPLICIT NONE 1577 1577 … … 1621 1621 write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap 1622 1622 endif 1623 1623 1624 1624 ! Pression si guidage sur niveaux P variables 1625 1625 if (guide_plevs.EQ.2) then … … 1630 1630 ENDIF 1631 1631 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1632 IF (rcode.NE.NF_NOERR) THEN 1632 IF (rcode.NE.NF_NOERR) THEN 1633 1633 abort_message='Nudging: error -> no PRES variable in file P.nc' 1634 1634 CALL abort_gcm(modname,abort_message,1) … … 1646 1646 ENDIF 1647 1647 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1648 IF (rcode.NE.NF_NOERR) THEN 1648 IF (rcode.NE.NF_NOERR) THEN 1649 1649 abort_message='Nudging: error -> no UWND variable in file u.nc' 1650 1650 CALL abort_gcm(modname,abort_message,1) … … 1653 1653 if (ncidpl.eq.-99) ncidpl=ncidu 1654 1654 1655 1655 1656 1656 status=NF90_INQ_DIMID(ncidu, "LONU", dimid) 1657 1657 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) … … 1667 1667 CALL abort_gcm(modname,abort_message,1) 1668 1668 ENDIF 1669 1669 1670 1670 endif 1671 1671 … … 1678 1678 ENDIF 1679 1679 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1680 IF (rcode.NE.NF_NOERR) THEN 1680 IF (rcode.NE.NF_NOERR) THEN 1681 1681 abort_message='Nudging: error -> no VWND variable in file v.nc' 1682 1682 CALL abort_gcm(modname,abort_message,1) … … 1684 1684 write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv 1685 1685 if (ncidpl.eq.-99) ncidpl=ncidv 1686 1686 1687 1687 status=NF90_INQ_DIMID(ncidv, "LONV", dimid) 1688 1688 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1689 1689 1690 1690 IF (lendim .NE. iip1) THEN 1691 1691 abort_message='dimension LONV different from iip1 in v.nc' … … 1700 1700 CALL abort_gcm(modname,abort_message,1) 1701 1701 ENDIF 1702 1702 1703 1703 endif 1704 1704 … … 1711 1711 ENDIF 1712 1712 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1713 IF (rcode.NE.NF_NOERR) THEN 1713 IF (rcode.NE.NF_NOERR) THEN 1714 1714 abort_message='Nudging: error -> no AIR variable in file T.nc' 1715 1715 CALL abort_gcm(modname,abort_message,1) … … 1742 1742 ENDIF 1743 1743 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1744 IF (rcode.NE.NF_NOERR) THEN 1744 IF (rcode.NE.NF_NOERR) THEN 1745 1745 abort_message='Nudging: error -> no RH variable in file hur.nc' 1746 1746 CALL abort_gcm(modname,abort_message,1) … … 1774 1774 ENDIF 1775 1775 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1776 IF (rcode.NE.NF_NOERR) THEN 1776 IF (rcode.NE.NF_NOERR) THEN 1777 1777 abort_message='Nudging: error -> no SP variable in file ps.nc' 1778 1778 CALL abort_gcm(modname,abort_message,1) … … 1788 1788 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1789 1789 IF (guide_plevs.EQ.1) THEN 1790 #ifdef NC_DOUBLE 1791 status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc) 1792 status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc) 1793 #else 1794 status=NF_GET_VARA_REAL(ncidpl,varidap,1,nlevnc,apnc) 1795 status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc) 1796 #endif 1790 status = nf90_put_var(ncidpl, varidap, apnc, [1], [nlevnc]) 1791 status = nf90_put_var(ncidpl, varidbp, bpnc, [1], [nlevnc]) 1797 1792 ELSEIF (guide_plevs.EQ.0) THEN 1798 #ifdef NC_DOUBLE 1799 status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc) 1800 #else 1801 status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc) 1802 #endif 1793 status = nf90_put_var(ncidpl, varidpl, apnc, [1], [nlevnc]) 1803 1794 !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous 1804 1795 IF(convert_Pa) apnc=apnc*100.! conversion en Pascals … … 1824 1815 1825 1816 IF (invert_y) start(2)=jjp1-jje_u+1 1826 ! Pression 1817 ! Pression 1827 1818 if (guide_plevs.EQ.2) then 1828 #ifdef NC_DOUBLE 1829 status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,pnat2) 1830 #else 1831 status=NF_GET_VARA_REAL(ncidp,varidp,start,count,pnat2) 1832 #endif 1819 status = nf90_put_var(ncidp, varidp, pnat2, start, count) 1833 1820 IF (invert_y) THEN 1834 1821 ! PRINT*,"Invertion impossible actuellement" … … 1840 1827 ! Vent zonal 1841 1828 if (guide_u) then 1842 #ifdef NC_DOUBLE 1843 status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unat2) 1844 #else 1845 status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unat2) 1846 #endif 1829 status = nf90_put_var(ncidu, varidu, unat2, start, count) 1847 1830 IF (invert_y) THEN 1848 1831 ! PRINT*,"Invertion impossible actuellement" … … 1856 1839 ! Temperature 1857 1840 if (guide_T) then 1858 #ifdef NC_DOUBLE 1859 status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnat2) 1860 #else 1861 status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnat2) 1862 #endif 1841 status = nf90_put_var(ncidt, varidt, tnat2, start, count) 1863 1842 IF (invert_y) THEN 1864 1843 ! PRINT*,"Invertion impossible actuellement" … … 1870 1849 ! Humidite 1871 1850 if (guide_Q) then 1872 #ifdef NC_DOUBLE 1873 status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,qnat2) 1874 #else 1875 status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,qnat2) 1876 #endif 1851 status = nf90_put_var(ncidQ, varidQ, qnat2, start, count) 1877 1852 IF (invert_y) THEN 1878 1853 ! PRINT*,"Invertion impossible actuellement" … … 1888 1863 count(2)=jjnb_v 1889 1864 IF (invert_y) start(2)=jjm-jje_v+1 1890 1891 #ifdef NC_DOUBLE 1892 status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnat2) 1893 #else 1894 status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnat2) 1895 #endif 1865 status = nf90_put_var(ncidv, varidv, vnat2, start, count) 1896 1866 IF (invert_y) THEN 1897 1867 ! PRINT*,"Invertion impossible actuellement" … … 1910 1880 count(4)=0 1911 1881 IF (invert_y) start(2)=jjp1-jje_u+1 1912 #ifdef NC_DOUBLE 1913 status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnat2) 1914 #else 1915 status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnat2) 1916 #endif 1882 status = nf90_put_var(ncidps, varidps, psnat2, start, count) 1917 1883 IF (invert_y) THEN 1918 1884 ! PRINT*,"Invertion impossible actuellement" … … 1926 1892 !======================================================================= 1927 1893 SUBROUTINE guide_read2D(timestep) 1928 1894 USE netcdf, ONLY: nf90_put_var 1929 1895 IMPLICIT NONE 1930 1896 … … 2075 2041 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 2076 2042 if (guide_plevs.EQ.1) then 2077 #ifdef NC_DOUBLE 2078 status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc) 2079 status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc) 2080 #else 2081 status=NF_GET_VARA_REAL(ncidpl,varidap,1,nlevnc,apnc) 2082 status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc) 2083 #endif 2043 status = nf90_put_var(ncidpl, varidap, apnc, [1], [nlevnc]) 2044 status = nf90_put_var(ncidpl, varidbp, bpnc, [1], [nlevnc]) 2084 2045 elseif (guide_plevs.EQ.0) THEN 2085 #ifdef NC_DOUBLE 2086 status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc) 2087 #else 2088 status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc) 2089 #endif 2046 status = nf90_put_var(ncidpl, varidpl, apnc, [1], [nlevnc]) 2090 2047 apnc=apnc*100.! conversion en Pascals 2091 2048 bpnc(:)=0. … … 2112 2069 ! Pression 2113 2070 if (guide_plevs.EQ.2) then 2114 #ifdef NC_DOUBLE 2115 status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,zu) 2116 #else 2117 status=NF_GET_VARA_REAL(ncidp,varidp,start,count,zu) 2118 #endif 2071 status = nf90_put_var(ncidp, varidp, zu, start, count) 2119 2072 DO i=1,iip1 2120 2073 pnat2(i,:,:)=zu(:,:) … … 2129 2082 ! Vent zonal 2130 2083 if (guide_u) then 2131 #ifdef NC_DOUBLE 2132 status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,zu) 2133 #else 2134 status=NF_GET_VARA_REAL(ncidu,varidu,start,count,zu) 2135 #endif 2084 status = nf90_put_var(ncidu, varidu, zu, start, count) 2136 2085 DO i=1,iip1 2137 2086 unat2(i,:,:)=zu(:,:) … … 2148 2097 ! Temperature 2149 2098 if (guide_T) then 2150 #ifdef NC_DOUBLE 2151 status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,zu) 2152 #else 2153 status=NF_GET_VARA_REAL(ncidt,varidt,start,count,zu) 2154 #endif 2099 status = nf90_put_var(ncidt, varidt, zu, start, count) 2155 2100 DO i=1,iip1 2156 2101 tnat2(i,:,:)=zu(:,:) … … 2166 2111 ! Humidite 2167 2112 if (guide_Q) then 2168 #ifdef NC_DOUBLE 2169 status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,zu) 2170 #else 2171 status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,zu) 2172 #endif 2113 status = nf90_put_var(ncidQ, varidQ, zu, start, count) 2173 2114 DO i=1,iip1 2174 2115 qnat2(i,:,:)=zu(:,:) 2175 2116 ENDDO 2176 2117 2177 2118 IF (invert_y) THEN 2178 2119 ! PRINT*,"Invertion impossible actuellement" … … 2187 2128 count(2)=jjnb_v 2188 2129 IF (invert_y) start(2)=jjm-jje_v+1 2189 #ifdef NC_DOUBLE 2190 status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,zv) 2191 #else 2192 status=NF_GET_VARA_REAL(ncidv,varidv,start,count,zv) 2193 #endif 2130 status = nf90_put_var(ncidv, varidv, zv, start, count) 2194 2131 DO i=1,iip1 2195 2132 vnat2(i,:,:)=zv(:,:) … … 2197 2134 2198 2135 IF (invert_y) THEN 2199 2136 2200 2137 ! PRINT*,"Invertion impossible actuellement" 2201 2138 ! CALL abort_gcm(modname,abort_message,1) … … 2213 2150 count(4)=0 2214 2151 IF (invert_y) start(2)=jjp1-jje_u+1 2215 #ifdef NC_DOUBLE 2216 status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,zu(:,1)) 2217 #else 2218 status=NF_GET_VARA_REAL(ncidps,varidps,start,count,zu(:,1)) 2219 #endif 2152 status = nf90_put_var(ncidps, varidps, zu(:, 1), start, count) 2220 2153 DO i=1,iip1 2221 2154 psnat2(i,:)=zu(:,1) … … 2230 2163 2231 2164 END SUBROUTINE guide_read2D 2232 2165 2233 2166 !======================================================================= 2234 2167 SUBROUTINE guide_out(varname,hsize,vsize,field_loc,factt) … … 2238 2171 USE comvert_mod, ONLY: presnivs 2239 2172 use netcdf95, only: nf95_def_var, nf95_put_var 2240 use netcdf, only: nf90_float 2173 use netcdf, only: nf90_float, nf90_put_var 2241 2174 2242 2175 IMPLICIT NONE … … 2246 2179 INCLUDE "netcdf.inc" 2247 2180 INCLUDE "comgeom2.h" 2248 2181 2249 2182 ! Variables entree 2250 2183 CHARACTER*(*), INTENT(IN) :: varname … … 2266 2199 REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo 2267 2200 CHARACTER(LEN=20),PARAMETER :: modname="guide_out" 2268 2201 2269 2202 !$OMP MASTER 2270 2203 ALLOCATE(field_glo(iip1,hsize,vsize)) … … 2294 2227 RETURN 2295 2228 ENDIF 2296 2229 2297 2230 !$OMP MASTER 2298 IF (timestep.EQ.0) THEN 2231 IF (timestep.EQ.0) THEN 2299 2232 ! ---------------------------------------------- 2300 2233 ! initialisation fichier de sortie … … 2303 2236 ierr=NF_CREATE("guide_ins.nc",IOR(NF_CLOBBER,NF_64BIT_OFFSET),nid) 2304 2237 ! Definition des dimensions 2305 ierr=NF_DEF_DIM(nid,"LONU",iip1,id_lonu) 2306 ierr=NF_DEF_DIM(nid,"LONV",iip1,id_lonv) 2307 ierr=NF_DEF_DIM(nid,"LATU",jjp1,id_latu) 2308 ierr=NF_DEF_DIM(nid,"LATV",jjm,id_latv) 2238 ierr=NF_DEF_DIM(nid,"LONU",iip1,id_lonu) 2239 ierr=NF_DEF_DIM(nid,"LONV",iip1,id_lonv) 2240 ierr=NF_DEF_DIM(nid,"LATU",jjp1,id_latu) 2241 ierr=NF_DEF_DIM(nid,"LATV",jjm,id_latv) 2309 2242 ierr=NF_DEF_DIM(nid,"LEVEL",llm,id_lev) 2310 2243 ierr=NF_DEF_DIM(nid,"TIME",NF_UNLIMITED,id_tim) … … 2324 2257 call nf95_def_var(nid, "alpha_q", nf90_float, (/id_lonv, id_latu/), & 2325 2258 varid_alpha_q) 2326 2259 2327 2260 ierr=NF_ENDDEF(nid) 2328 2261 2329 2262 ! Enregistrement des variables dimensions 2330 #ifdef NC_DOUBLE 2331 ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi) 2332 ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi) 2333 ierr = NF_PUT_VAR_DOUBLE(nid,vid_latu,rlatu*180./pi) 2334 ierr = NF_PUT_VAR_DOUBLE(nid,vid_latv,rlatv*180./pi) 2335 ierr = NF_PUT_VAR_DOUBLE(nid,vid_lev,presnivs) 2336 ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu) 2337 ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv) 2338 ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,zu) 2339 ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,zv) 2340 #else 2341 ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi) 2342 ierr = NF_PUT_VAR_REAL(nid,vid_lonv,rlonv*180./pi) 2343 ierr = NF_PUT_VAR_REAL(nid,vid_latu,rlatu*180./pi) 2344 ierr = NF_PUT_VAR_REAL(nid,vid_latv,rlatv*180./pi) 2345 ierr = NF_PUT_VAR_REAL(nid,vid_lev,presnivs) 2346 ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu) 2347 ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv) 2348 ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u) 2349 ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v) 2350 #endif 2263 ierr = nf90_put_var(nid, vid_lonu, rlonu * 180. / pi) 2264 ierr = nf90_put_var(nid, vid_lonv, rlonv * 180. / pi) 2265 ierr = nf90_put_var(nid, vid_latu, rlatu * 180. / pi) 2266 ierr = nf90_put_var(nid, vid_latv, rlatv * 180. / pi) 2267 ierr = nf90_put_var(nid, vid_lev, presnivs) 2268 ierr = nf90_put_var(nid, vid_cu, cu) 2269 ierr = nf90_put_var(nid, vid_cv, cv) 2270 ierr = nf90_put_var(nid, vid_au, zu) 2271 ierr = nf90_put_var(nid, vid_av, zv) 2351 2272 call nf95_put_var(nid, varid_alpha_t, zt) 2352 2273 call nf95_put_var(nid, varid_alpha_q, zq) … … 2387 2308 ierr = NF_DEF_VAR(nid,"q",NF_FLOAT,4,dim4,varid) 2388 2309 ENDIF 2389 2310 2390 2311 ierr = NF_ENDDEF(nid) 2391 2312 ierr = NF_CLOSE(nid) … … 2395 2316 ! Enregistrement du champ 2396 2317 ! -------------------------------------------------------------------- 2397 2318 2398 2319 ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid) 2399 2320 … … 2420 2341 CASE("u","ua") 2421 2342 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 2422 DO l=1,llm 2343 DO l=1,llm 2423 2344 field_glo(:,2:jjm,l)=field_glo(:,2:jjm,l)/cu(:,2:jjm) 2424 2345 field_glo(:,1,l)=0. ; field_glo(:,jjp1,l)=0. … … 2438 2359 !$OMP MASTER 2439 2360 2440 #ifdef NC_DOUBLE 2441 ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field_glo) 2442 #else 2443 ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field_glo) 2444 #endif 2445 2361 ierr = nf90_put_var(nid, varid, field_glo, start, count) 2446 2362 ierr = NF_CLOSE(nid) 2447 2363 … … 2451 2367 2452 2368 END SUBROUTINE guide_out 2453 2454 2369 2370 2455 2371 !=========================================================================== 2456 2372 subroutine correctbid(iim,nl,x) -
LMDZ6/trunk/libf/dynphy_lonlat/phylmd/limit_netcdf.F90
r5084 r5249 80 80 USE comconst_mod, ONLY: pi 81 81 USE phys_cal_mod, ONLY: calend 82 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 82 83 IMPLICIT NONE 83 84 !------------------------------------------------------------------------------- … … 107 108 INTEGER :: id_tim, id_SST, id_BILS, id_RUG, id_ALB 108 109 INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC, varid_longitude, varid_latitude 109 INTEGER :: NF90_FORMAT110 110 INTEGER :: ndays !--- Depending on the output calendar 111 111 CHARACTER(LEN=ns) :: str 112 112 113 113 !--- INITIALIZATIONS ----------------------------------------------------------- 114 #ifdef NC_DOUBLE115 NF90_FORMAT=NF90_DOUBLE116 #else117 NF90_FORMAT=NF90_FLOAT118 #endif119 114 CALL inigeom 120 115 -
LMDZ6/trunk/libf/misc/lmdz_cppkeys_wrapper.F90
r5230 r5249 8 8 ! CPP_PHYS -> CPPKEY_PHYS 9 9 ! INCA -> CPPKEY_INCA ! -> also in lmdz_inca_wrappers.F90 10 ! REPROBUS -> CPPKEY_REPROBUS ! -> also in lmdz_reprobus_wrappers.F9010 ! REPROBUS -> CPPKEY_REPROBUS ! -> also in lmdz_reprobus_wrappers.F90 11 11 ! CPP_StratAer -> CPPKEY_STRATAER 12 ! CPP_DUST -> CPPKEY_DUST 13 ! CPP_INLANDSIS -> CPPKEY_INLANDSIS 14 ! OUTPUT_PHYS_SCM-> CPPKEY_OUTPUTPHYSSCM 15 ! CPP_COSP -> CPPKEY_COSP 16 ! CPP_COSP2 -> CPPKEY_COSP2 17 ! CPP_COSPV2 -> CPPKEY_COSPV2 12 ! CPP_DUST -> CPPKEY_DUST ! only used in PHYS 13 ! CPP_INLANDSIS -> CPPKEY_INLANDSIS ! only used in PHYS 14 ! OUTPUT_PHYS_SCM-> CPPKEY_OUTPUTPHYSSCM ! only used in DYN1D 15 ! CPP_COSP -> CPPKEY_COSP ! only used in PHYS 16 ! CPP_COSP2 -> CPPKEY_COSP2 ! only used in PHYS 17 ! CPP_COSPV2 -> CPPKEY_COSPV2 ! only used in PHYS 18 ! 19 ! NB Laurent 09/24: Certaines clés sont utilisées uniquement dans la physique, mais on décide de les laisser dans misc/ pour l'instant. 18 20 ! --------------------------------------------- 19 21 -
LMDZ6/trunk/libf/phylmd/Dust/read_dust.F90
r5246 r5249 3 3 USE mod_grid_phy_lmdz 4 4 USE mod_phys_lmdz_para 5 USE netcdf, ONLY: nf90_get_var 5 6 IMPLICIT NONE 6 7 ! … … 46 47 start(3)=step 47 48 ! 48 #ifdef NC_DOUBLE 49 ! status=NF_GET_VARA_DOUBLE(ncid1,varid1,start,count,dust_nc) 50 status=NF_GET_VARA_DOUBLE(ncid1,varid1,start,count,dust_nc_glo) 51 #else 52 ! status=NF_GET_VARA_REAL(ncid1,varid1,start,count,dust_nc) 53 status=NF_GET_VARA_REAL(ncid1,varid1,start,count,dust_nc_glo) 54 #endif 49 status = nf90_get_var(ncid1, varid1, dust_nc_glo, start, count) 50 55 51 ! 56 52 ! call correctbid(iim,jjp1,dust_nc) -
LMDZ6/trunk/libf/phylmd/Dust/read_surface.F90
r5084 r5249 75 75 varid=NCVID(ncid,latstr,rcode) 76 76 77 #ifdef NC_DOUBLE 78 status=NF_GET_VARA_DOUBLE(ncid,varid,startj,endj,lats_glo) 79 #else 80 status=NF_GET_VARA_REAL(ncid,varid,startj,endj,lats_glo) 81 #endif 77 status = nf90_get_var(ncid, varid, lats_glo, startj, endj) 82 78 ! print *,latstr,varid,status,jjp1,rcode 83 79 ! IF (status .NE. NF_NOERR) print*,'NOOOOOOO' … … 113 109 ! Lecture 114 110 ! ----------------------- 115 #ifdef NC_DOUBLE 116 status=NF_GET_VARA_DOUBLE(ncid,varid,start,count,tmp_dyn_glo) 117 #else 118 status=NF_GET_VARA_REAL(ncid,varid,start,count,tmp_dyn_glo) 119 #endif 111 status = nf90_get_var(ncid, varid, tmp_dyn_glo, start, count) 120 112 121 113 ! call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn ') -
LMDZ6/trunk/libf/phylmd/Dust/read_vent.F90
r5246 r5249 52 52 start(3)=step 53 53 ! 54 #ifdef NC_DOUBLE 55 ! status=NF_GET_VARA_DOUBLE(ncidu1,varidu1,start,count,u10m_nc) 56 status=NF_GET_VARA_DOUBLE(ncidu1,varidu1,start,count,u10m_nc_glo) 57 #else 58 ! status=NF_GET_VARA_REAL(ncidu1,varidu1,start,count,u10m_nc) 59 status=NF_GET_VARA_REAL(ncidu1,varidu1,start,count,u10m_nc_glo) 60 #endif 54 status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count) 55 61 56 ! print *,status 62 57 ! 63 #ifdef NC_DOUBLE 64 ! status=NF_GET_VARA_DOUBLE(ncidv1,varidv1,start,count,v10m_nc) 65 status=NF_GET_VARA_DOUBLE(ncidv1,varidv1,start,count,v10m_nc_glo) 66 #else 67 ! status=NF_GET_VARA_REAL(ncidv1,varidv1,start,count,v10m_nc) 68 status=NF_GET_VARA_REAL(ncidv1,varidv1,start,count,v10m_nc_glo) 69 #endif 58 status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count) 59 70 60 ! 71 61 -
LMDZ6/trunk/libf/phylmd/condsurf.F90
r5084 r5249 7 7 USE indice_sol_mod 8 8 USE time_phylmdz_mod, ONLY: annee_ref 9 USE netcdf, ONLY: nf90_get_var 9 10 IMPLICIT NONE 10 11 … … 110 111 END IF 111 112 PRINT *, 'debut,epais', debut, epais, 'jour,jourvrai', jour, jourvrai 112 #ifdef NC_DOUBLE 113 ierr = nf_get_vara_double(nid, nvarid, debut, epais, lmt_bils_glo) 114 #else 115 ierr = nf_get_vara_real(nid, nvarid, debut, epais, lmt_bils_glo) 116 #endif 113 ierr = nf90_get_var(nid, nvarid, lmt_bils_glo, debut, epais) 117 114 IF (ierr/=nf_noerr) THEN 118 115 CALL abort_physic('condsurf', 'Lecture echouee pour <BILS>', 1) -
LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_amma_read.F90
r5084 r5249 179 179 180 180 !program reading forcings of the AMMA case study 181 USE netcdf, ONLY: nf90_get_var 181 182 implicit none 182 183 INCLUDE "netcdf.inc" … … 268 269 ! call catchaxis(nid,ntime,nlevel,time,z,ierr) 269 270 270 #ifdef NC_DOUBLE 271 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz) 272 #else 273 ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz) 274 #endif 271 ierr = nf90_get_var(nid, var3didin(1), zz) 275 272 if(ierr/=NF_NOERR) then 276 273 write(*,*) NF_STRERROR(ierr) … … 279 276 ! write(*,*)'lecture z ok',zz 280 277 281 #ifdef NC_DOUBLE 282 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),temp) 283 #else 284 ierr = NF_GET_VAR_REAL(nid,var3didin(2),temp) 285 #endif 278 ierr = nf90_get_var(nid, var3didin(2), temp) 286 279 if(ierr/=NF_NOERR) then 287 280 write(*,*) NF_STRERROR(ierr) … … 290 283 ! write(*,*)'lecture th ok',temp 291 284 292 #ifdef NC_DOUBLE 293 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qv) 294 #else 295 ierr = NF_GET_VAR_REAL(nid,var3didin(3),qv) 296 #endif 285 ierr = nf90_get_var(nid, var3didin(3), qv) 297 286 if(ierr/=NF_NOERR) then 298 287 write(*,*) NF_STRERROR(ierr) … … 301 290 ! write(*,*)'lecture qv ok',qv 302 291 303 #ifdef NC_DOUBLE 304 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u) 305 #else 306 ierr = NF_GET_VAR_REAL(nid,var3didin(4),u) 307 #endif 292 ierr = nf90_get_var(nid, var3didin(4), u) 308 293 if(ierr/=NF_NOERR) then 309 294 write(*,*) NF_STRERROR(ierr) … … 312 297 ! write(*,*)'lecture u ok',u 313 298 314 #ifdef NC_DOUBLE 315 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v) 316 #else 317 ierr = NF_GET_VAR_REAL(nid,var3didin(5),v) 318 #endif 299 ierr = nf90_get_var(nid, var3didin(5), v) 319 300 if(ierr/=NF_NOERR) then 320 301 write(*,*) NF_STRERROR(ierr) … … 323 304 ! write(*,*)'lecture v ok',v 324 305 325 #ifdef NC_DOUBLE 326 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),dw) 327 #else 328 ierr = NF_GET_VAR_REAL(nid,var3didin(6),dw) 329 #endif 306 ierr = nf90_get_var(nid, var3didin(6), dw) 330 307 if(ierr/=NF_NOERR) then 331 308 write(*,*) NF_STRERROR(ierr) … … 334 311 ! write(*,*)'lecture w ok',dw 335 312 336 #ifdef NC_DOUBLE 337 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),dt) 338 #else 339 ierr = NF_GET_VAR_REAL(nid,var3didin(7),dt) 340 #endif 313 ierr = nf90_get_var(nid, var3didin(7), dt) 341 314 if(ierr/=NF_NOERR) then 342 315 write(*,*) NF_STRERROR(ierr) … … 345 318 ! write(*,*)'lecture dt ok',dt 346 319 347 #ifdef NC_DOUBLE 348 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),dq) 349 #else 350 ierr = NF_GET_VAR_REAL(nid,var3didin(8),dq) 351 #endif 320 ierr = nf90_get_var(nid, var3didin(8), dq) 352 321 if(ierr/=NF_NOERR) then 353 322 write(*,*) NF_STRERROR(ierr) … … 356 325 ! write(*,*)'lecture dq ok',dq 357 326 358 #ifdef NC_DOUBLE 359 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),sens) 360 #else 361 ierr = NF_GET_VAR_REAL(nid,var3didin(9),sens) 362 #endif 327 ierr = nf90_get_var(nid, var3didin(9), sens) 363 328 if(ierr/=NF_NOERR) then 364 329 write(*,*) NF_STRERROR(ierr) … … 367 332 ! write(*,*)'lecture sens ok',sens 368 333 369 #ifdef NC_DOUBLE 370 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),flat) 371 #else 372 ierr = NF_GET_VAR_REAL(nid,var3didin(10),flat) 373 #endif 334 ierr = nf90_get_var(nid, var3didin(10), flat) 374 335 if(ierr/=NF_NOERR) then 375 336 write(*,*) NF_STRERROR(ierr) … … 378 339 ! write(*,*)'lecture flat ok',flat 379 340 380 #ifdef NC_DOUBLE 381 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),pp) 382 #else 383 ierr = NF_GET_VAR_REAL(nid,var3didin(11),pp) 384 #endif 341 ierr = nf90_get_var(nid, var3didin(11), pp) 385 342 if(ierr/=NF_NOERR) then 386 343 write(*,*) NF_STRERROR(ierr) … … 437 394 endif 438 395 if (annee_ref.eq.2006 .and. day1.lt.day_ini_amma) then 439 print*,'AMMA a d ébutéle 10 juillet 2006',day1,day_ini_amma396 print*,'AMMA a d�but� le 10 juillet 2006',day1,day_ini_amma 440 397 print*,'Changer dayref dans run.def' 441 398 stop -
LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read.F90
r5084 r5249 266 266 267 267 !program reading forcing of the case study 268 USE netcdf, ONLY: nf90_get_var 268 269 implicit none 269 270 INCLUDE "netcdf.inc" … … 532 533 endif 533 534 534 #ifdef NC_DOUBLE 535 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz) 536 #else 537 ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz) 538 #endif 535 ierr = nf90_get_var(nid, var3didin(1), zz) 539 536 if(ierr/=NF_NOERR) then 540 537 write(*,*) NF_STRERROR(ierr) … … 543 540 ! write(*,*)'lecture z ok',zz 544 541 545 #ifdef NC_DOUBLE 546 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),pp) 547 #else 548 ierr = NF_GET_VAR_REAL(nid,var3didin(2),pp) 549 #endif 542 ierr = nf90_get_var(nid, var3didin(2), pp) 550 543 if(ierr/=NF_NOERR) then 551 544 write(*,*) NF_STRERROR(ierr) … … 555 548 556 549 557 #ifdef NC_DOUBLE 558 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),temp) 559 #else 560 ierr = NF_GET_VAR_REAL(nid,var3didin(3),temp) 561 #endif 550 ierr = nf90_get_var(nid, var3didin(3), temp) 562 551 if(ierr/=NF_NOERR) then 563 552 write(*,*) NF_STRERROR(ierr) … … 566 555 ! write(*,*)'lecture T ok',temp 567 556 568 #ifdef NC_DOUBLE 569 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),qv) 570 #else 571 ierr = NF_GET_VAR_REAL(nid,var3didin(4),qv) 572 #endif 557 ierr = nf90_get_var(nid, var3didin(4), qv) 573 558 if(ierr/=NF_NOERR) then 574 559 write(*,*) NF_STRERROR(ierr) … … 577 562 ! write(*,*)'lecture qv ok',qv 578 563 579 #ifdef NC_DOUBLE 580 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),rh) 581 #else 582 ierr = NF_GET_VAR_REAL(nid,var3didin(5),rh) 583 #endif 564 ierr = nf90_get_var(nid, var3didin(5), rh) 584 565 if(ierr/=NF_NOERR) then 585 566 write(*,*) NF_STRERROR(ierr) … … 588 569 ! write(*,*)'lecture rh ok',rh 589 570 590 #ifdef NC_DOUBLE 591 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),theta) 592 #else 593 ierr = NF_GET_VAR_REAL(nid,var3didin(6),theta) 594 #endif 571 ierr = nf90_get_var(nid, var3didin(6), theta) 595 572 if(ierr/=NF_NOERR) then 596 573 write(*,*) NF_STRERROR(ierr) … … 599 576 ! write(*,*)'lecture theta ok',theta 600 577 601 #ifdef NC_DOUBLE 602 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),rv) 603 #else 604 ierr = NF_GET_VAR_REAL(nid,var3didin(7),rv) 605 #endif 578 ierr = nf90_get_var(nid, var3didin(7), rv) 606 579 if(ierr/=NF_NOERR) then 607 580 write(*,*) NF_STRERROR(ierr) … … 610 583 ! write(*,*)'lecture rv ok',rv 611 584 612 #ifdef NC_DOUBLE 613 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),u) 614 #else 615 ierr = NF_GET_VAR_REAL(nid,var3didin(8),u) 616 #endif 585 ierr = nf90_get_var(nid, var3didin(8), u) 617 586 if(ierr/=NF_NOERR) then 618 587 write(*,*) NF_STRERROR(ierr) … … 621 590 ! write(*,*)'lecture u ok',u 622 591 623 #ifdef NC_DOUBLE 624 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),v) 625 #else 626 ierr = NF_GET_VAR_REAL(nid,var3didin(9),v) 627 #endif 592 ierr = nf90_get_var(nid, var3didin(9), v) 628 593 if(ierr/=NF_NOERR) then 629 594 write(*,*) NF_STRERROR(ierr) … … 632 597 ! write(*,*)'lecture v ok',v 633 598 634 #ifdef NC_DOUBLE 635 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),ug) 636 #else 637 ierr = NF_GET_VAR_REAL(nid,var3didin(10),ug) 638 #endif 599 ierr = nf90_get_var(nid, var3didin(10), ug) 639 600 if(ierr/=NF_NOERR) then 640 601 write(*,*) NF_STRERROR(ierr) … … 643 604 ! write(*,*)'lecture ug ok',ug 644 605 645 #ifdef NC_DOUBLE 646 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),vg) 647 #else 648 ierr = NF_GET_VAR_REAL(nid,var3didin(11),vg) 649 #endif 606 ierr = nf90_get_var(nid, var3didin(11), vg) 650 607 if(ierr/=NF_NOERR) then 651 608 write(*,*) NF_STRERROR(ierr) … … 654 611 ! write(*,*)'lecture vg ok',vg 655 612 656 #ifdef NC_DOUBLE 657 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),w) 658 #else 659 ierr = NF_GET_VAR_REAL(nid,var3didin(12),w) 660 #endif 613 ierr = nf90_get_var(nid, var3didin(12), w) 661 614 if(ierr/=NF_NOERR) then 662 615 write(*,*) NF_STRERROR(ierr) … … 665 618 ! write(*,*)'lecture w ok',w 666 619 667 #ifdef NC_DOUBLE 668 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),du) 669 #else 670 ierr = NF_GET_VAR_REAL(nid,var3didin(13),du) 671 #endif 620 ierr = nf90_get_var(nid, var3didin(13), du) 672 621 if(ierr/=NF_NOERR) then 673 622 write(*,*) NF_STRERROR(ierr) … … 676 625 ! write(*,*)'lecture du ok',du 677 626 678 #ifdef NC_DOUBLE 679 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),hu) 680 #else 681 ierr = NF_GET_VAR_REAL(nid,var3didin(14),hu) 682 #endif 627 ierr = nf90_get_var(nid, var3didin(14), hu) 683 628 if(ierr/=NF_NOERR) then 684 629 write(*,*) NF_STRERROR(ierr) … … 687 632 ! write(*,*)'lecture hu ok',hu 688 633 689 #ifdef NC_DOUBLE 690 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),vu) 691 #else 692 ierr = NF_GET_VAR_REAL(nid,var3didin(15),vu) 693 #endif 634 ierr = nf90_get_var(nid, var3didin(15), vu) 694 635 if(ierr/=NF_NOERR) then 695 636 write(*,*) NF_STRERROR(ierr) … … 698 639 ! write(*,*)'lecture vu ok',vu 699 640 700 #ifdef NC_DOUBLE 701 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),dv) 702 #else 703 ierr = NF_GET_VAR_REAL(nid,var3didin(16),dv) 704 #endif 641 ierr = nf90_get_var(nid, var3didin(16), dv) 705 642 if(ierr/=NF_NOERR) then 706 643 write(*,*) NF_STRERROR(ierr) … … 709 646 ! write(*,*)'lecture dv ok',dv 710 647 711 #ifdef NC_DOUBLE 712 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),hv) 713 #else 714 ierr = NF_GET_VAR_REAL(nid,var3didin(17),hv) 715 #endif 648 ierr = nf90_get_var(nid, var3didin(17), hv) 716 649 if(ierr/=NF_NOERR) then 717 650 write(*,*) NF_STRERROR(ierr) … … 720 653 ! write(*,*)'lecture hv ok',hv 721 654 722 #ifdef NC_DOUBLE 723 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),vv) 724 #else 725 ierr = NF_GET_VAR_REAL(nid,var3didin(18),vv) 726 #endif 655 ierr = nf90_get_var(nid, var3didin(18), vv) 727 656 if(ierr/=NF_NOERR) then 728 657 write(*,*) NF_STRERROR(ierr) … … 731 660 ! write(*,*)'lecture vv ok',vv 732 661 733 #ifdef NC_DOUBLE 734 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),dt) 735 #else 736 ierr = NF_GET_VAR_REAL(nid,var3didin(19),dt) 737 #endif 662 ierr = nf90_get_var(nid, var3didin(19), dt) 738 663 if(ierr/=NF_NOERR) then 739 664 write(*,*) NF_STRERROR(ierr) … … 742 667 ! write(*,*)'lecture dt ok',dt 743 668 744 #ifdef NC_DOUBLE 745 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),ht) 746 #else 747 ierr = NF_GET_VAR_REAL(nid,var3didin(20),ht) 748 #endif 669 ierr = nf90_get_var(nid, var3didin(20), ht) 749 670 if(ierr/=NF_NOERR) then 750 671 write(*,*) NF_STRERROR(ierr) … … 753 674 ! write(*,*)'lecture ht ok',ht 754 675 755 #ifdef NC_DOUBLE 756 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(21),vt) 757 #else 758 ierr = NF_GET_VAR_REAL(nid,var3didin(21),vt) 759 #endif 676 ierr = nf90_get_var(nid, var3didin(21), vt) 760 677 if(ierr/=NF_NOERR) then 761 678 write(*,*) NF_STRERROR(ierr) … … 764 681 ! write(*,*)'lecture vt ok',vt 765 682 766 #ifdef NC_DOUBLE 767 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(22),dq) 768 #else 769 ierr = NF_GET_VAR_REAL(nid,var3didin(22),dq) 770 #endif 683 ierr = nf90_get_var(nid, var3didin(22), dq) 771 684 if(ierr/=NF_NOERR) then 772 685 write(*,*) NF_STRERROR(ierr) … … 775 688 ! write(*,*)'lecture dq ok',dq 776 689 777 #ifdef NC_DOUBLE 778 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(23),hq) 779 #else 780 ierr = NF_GET_VAR_REAL(nid,var3didin(23),hq) 781 #endif 690 ierr = nf90_get_var(nid, var3didin(23), hq) 782 691 if(ierr/=NF_NOERR) then 783 692 write(*,*) NF_STRERROR(ierr) … … 786 695 ! write(*,*)'lecture hq ok',hq 787 696 788 #ifdef NC_DOUBLE 789 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(24),vq) 790 #else 791 ierr = NF_GET_VAR_REAL(nid,var3didin(24),vq) 792 #endif 697 ierr = nf90_get_var(nid, var3didin(24), vq) 793 698 if(ierr/=NF_NOERR) then 794 699 write(*,*) NF_STRERROR(ierr) … … 797 702 ! write(*,*)'lecture vq ok',vq 798 703 799 #ifdef NC_DOUBLE 800 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(25),dth) 801 #else 802 ierr = NF_GET_VAR_REAL(nid,var3didin(25),dth) 803 #endif 704 ierr = nf90_get_var(nid, var3didin(25), dth) 804 705 if(ierr/=NF_NOERR) then 805 706 write(*,*) NF_STRERROR(ierr) … … 808 709 ! write(*,*)'lecture dth ok',dth 809 710 810 #ifdef NC_DOUBLE 811 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(26),hth) 812 #else 813 ierr = NF_GET_VAR_REAL(nid,var3didin(26),hth) 814 #endif 711 ierr = nf90_get_var(nid, var3didin(26), hth) 815 712 if(ierr/=NF_NOERR) then 816 713 write(*,*) NF_STRERROR(ierr) … … 819 716 ! write(*,*)'lecture hth ok',hth 820 717 821 #ifdef NC_DOUBLE 822 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(27),vth) 823 #else 824 ierr = NF_GET_VAR_REAL(nid,var3didin(27),vth) 825 #endif 718 ierr = nf90_get_var(nid, var3didin(27), vth) 826 719 if(ierr/=NF_NOERR) then 827 720 write(*,*) NF_STRERROR(ierr) … … 830 723 ! write(*,*)'lecture vth ok',vth 831 724 832 #ifdef NC_DOUBLE 833 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(28),dr) 834 #else 835 ierr = NF_GET_VAR_REAL(nid,var3didin(28),dr) 836 #endif 725 ierr = nf90_get_var(nid, var3didin(28), dr) 837 726 if(ierr/=NF_NOERR) then 838 727 write(*,*) NF_STRERROR(ierr) … … 841 730 ! write(*,*)'lecture dr ok',dr 842 731 843 #ifdef NC_DOUBLE 844 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(29),hr) 845 #else 846 ierr = NF_GET_VAR_REAL(nid,var3didin(29),hr) 847 #endif 732 ierr = nf90_get_var(nid, var3didin(29), hr) 848 733 if(ierr/=NF_NOERR) then 849 734 write(*,*) NF_STRERROR(ierr) … … 852 737 ! write(*,*)'lecture hr ok',hr 853 738 854 #ifdef NC_DOUBLE 855 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(30),vr) 856 #else 857 ierr = NF_GET_VAR_REAL(nid,var3didin(30),vr) 858 #endif 739 ierr = nf90_get_var(nid, var3didin(30), vr) 859 740 if(ierr/=NF_NOERR) then 860 741 write(*,*) NF_STRERROR(ierr) … … 863 744 ! write(*,*)'lecture vr ok',vr 864 745 865 #ifdef NC_DOUBLE 866 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(31),dtrad) 867 #else 868 ierr = NF_GET_VAR_REAL(nid,var3didin(31),dtrad) 869 #endif 746 ierr = nf90_get_var(nid, var3didin(31), dtrad) 870 747 if(ierr/=NF_NOERR) then 871 748 write(*,*) NF_STRERROR(ierr) … … 874 751 ! write(*,*)'lecture dtrad ok',dtrad 875 752 876 #ifdef NC_DOUBLE 877 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(32),sens) 878 #else 879 ierr = NF_GET_VAR_REAL(nid,var3didin(32),sens) 880 #endif 753 ierr = nf90_get_var(nid, var3didin(32), sens) 881 754 if(ierr/=NF_NOERR) then 882 755 write(*,*) NF_STRERROR(ierr) … … 885 758 ! write(*,*)'lecture sens ok',sens 886 759 887 #ifdef NC_DOUBLE 888 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(33),flat) 889 #else 890 ierr = NF_GET_VAR_REAL(nid,var3didin(33),flat) 891 #endif 760 ierr = nf90_get_var(nid, var3didin(33), flat) 892 761 if(ierr/=NF_NOERR) then 893 762 write(*,*) NF_STRERROR(ierr) … … 896 765 ! write(*,*)'lecture flat ok',flat 897 766 898 #ifdef NC_DOUBLE 899 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(34),ts) 900 #else 901 ierr = NF_GET_VAR_REAL(nid,var3didin(34),ts) 902 #endif 767 ierr = nf90_get_var(nid, var3didin(34), ts) 903 768 if(ierr/=NF_NOERR) then 904 769 write(*,*) NF_STRERROR(ierr) … … 907 772 ! write(*,*)'lecture ts ok',ts 908 773 909 #ifdef NC_DOUBLE 910 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(35),ustar) 911 #else 912 ierr = NF_GET_VAR_REAL(nid,var3didin(35),ustar) 913 #endif 774 ierr = nf90_get_var(nid, var3didin(35), ustar) 914 775 if(ierr/=NF_NOERR) then 915 776 write(*,*) NF_STRERROR(ierr) … … 918 779 ! write(*,*)'lecture ustar ok',ustar 919 780 920 #ifdef NC_DOUBLE 921 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(36),uw) 922 #else 923 ierr = NF_GET_VAR_REAL(nid,var3didin(36),uw) 924 #endif 781 ierr = nf90_get_var(nid, var3didin(36), uw) 925 782 if(ierr/=NF_NOERR) then 926 783 write(*,*) NF_STRERROR(ierr) … … 929 786 ! write(*,*)'lecture uw ok',uw 930 787 931 #ifdef NC_DOUBLE 932 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(37),vw) 933 #else 934 ierr = NF_GET_VAR_REAL(nid,var3didin(37),vw) 935 #endif 788 ierr = nf90_get_var(nid, var3didin(37), vw) 936 789 if(ierr/=NF_NOERR) then 937 790 write(*,*) NF_STRERROR(ierr) … … 940 793 ! write(*,*)'lecture vw ok',vw 941 794 942 #ifdef NC_DOUBLE 943 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(38),q1) 944 #else 945 ierr = NF_GET_VAR_REAL(nid,var3didin(38),q1) 946 #endif 795 ierr = nf90_get_var(nid, var3didin(38), q1) 947 796 if(ierr/=NF_NOERR) then 948 797 write(*,*) NF_STRERROR(ierr) … … 951 800 ! write(*,*)'lecture q1 ok',q1 952 801 953 #ifdef NC_DOUBLE 954 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(39),q2) 955 #else 956 ierr = NF_GET_VAR_REAL(nid,var3didin(39),q2) 957 #endif 802 ierr = nf90_get_var(nid, var3didin(39), q2) 958 803 if(ierr/=NF_NOERR) then 959 804 write(*,*) NF_STRERROR(ierr) -
LMDZ6/trunk/libf/phylmd/interfoce_lim.F90
r5084 r5249 10 10 USE mod_phys_lmdz_para 11 11 USE indice_sol_mod 12 USE netcdf, ONLY: nf90_get_var 12 13 13 14 IMPLICIT NONE … … 137 138 CALL abort_physic(modname,abort_message,1) 138 139 ENDIF 139 #ifdef NC_DOUBLE 140 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_oce)) 141 #else 142 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_oce)) 143 #endif 140 ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_oce),start,epais) 144 141 IF (ierr /= NF_NOERR) THEN 145 142 abort_message = 'Lecture echouee pour <FOCE>' … … 154 151 CALL abort_physic(modname,abort_message,1) 155 152 ENDIF 156 #ifdef NC_DOUBLE 157 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_sic)) 158 #else 159 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_sic)) 160 #endif 153 ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_sic),start,epais) 161 154 IF (ierr /= NF_NOERR) THEN 162 155 abort_message = 'Lecture echouee pour <FSIC>' … … 171 164 CALL abort_physic(modname,abort_message,1) 172 165 ENDIF 173 #ifdef NC_DOUBLE 174 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_ter)) 175 #else 176 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_ter)) 177 #endif 166 ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_ter),start,epais) 178 167 IF (ierr /= NF_NOERR) THEN 179 168 abort_message = 'Lecture echouee pour <FTER>' … … 188 177 CALL abort_physic(modname,abort_message,1) 189 178 ENDIF 190 #ifdef NC_DOUBLE 191 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_lic)) 192 #else 193 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_lic)) 194 #endif 179 ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_lic),start,epais) 195 180 IF (ierr /= NF_NOERR) THEN 196 181 abort_message = 'Lecture echouee pour <FLIC>' … … 205 190 CALL abort_physic(modname,abort_message,1) 206 191 ENDIF 207 #ifdef NC_DOUBLE 208 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, nat_lu) 209 #else 210 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, nat_lu) 211 #endif 192 ierr = nf90_get_var(nid,nvarid,nat_lu,start,epais) 212 193 IF (ierr /= NF_NOERR) THEN 213 194 abort_message = 'Lecture echouee pour <NAT>' … … 239 220 CALL abort_physic(modname,abort_message,1) 240 221 ENDIF 241 #ifdef NC_DOUBLE 242 ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, sst_lu) 243 #else 244 ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, sst_lu) 245 #endif 222 ierr = nf90_get_var(nid,nvarid,sst_lu,start,epais) 246 223 IF (ierr /= NF_NOERR) THEN 247 224 abort_message = 'Lecture echouee pour <SST>' -
LMDZ6/trunk/libf/phylmd/iostart.F90
r5084 r5249 390 390 USE mod_grid_phy_lmdz 391 391 USE mod_phys_lmdz_para 392 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 392 393 IMPLICIT NONE 393 394 INTEGER, INTENT(IN) :: pass … … 424 425 425 426 ! ierr = NF90_REDEF (nid_restart) 426 #ifdef NC_DOUBLE 427 ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid) 428 #else 429 ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid) 430 #endif 427 ierr = NF90_DEF_VAR (nid_restart, field_name, nf90_format,(/ idim /),nvarid) 431 428 IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title) 432 429 ! ierr = NF90_ENDDEF(nid_restart) … … 515 512 USE dimphy 516 513 USE mod_phys_lmdz_para 514 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 517 515 IMPLICIT NONE 518 516 INTEGER, INTENT(IN) :: pass … … 536 534 537 535 ! ierr = NF90_REDEF (nid_restart) 538 539 #ifdef NC_DOUBLE 540 ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid) 541 #else 542 ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid) 543 #endif 536 ierr = NF90_DEF_VAR (nid_restart, var_name, nf90_format,(/ idim1 /),nvarid) 544 537 IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title) 545 538 ! ierr = NF90_ENDDEF(nid_restart) -
LMDZ6/trunk/libf/phylmd/phyaqua_mod.F90
r5084 r5249 572 572 USE mod_phys_lmdz_transfert_para, ONLY: gather 573 573 USE phys_cal_mod, ONLY: year_len 574 use netcdf, only: nf90_def_var, nf90_double, nf90_float 574 use netcdf, only: nf90_def_var, nf90_double, nf90_float, nf90_put_var 575 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 575 576 IMPLICIT NONE 576 577 include "netcdf.inc" … … 616 617 dims(2) = ntim 617 618 618 #ifdef NC_DOUBLE 619 ierr = nf90_def_var(nid, 'TEMPS', nf90_double, [ntim], id_tim) 620 #else 621 ierr = nf90_def_var(nid, 'TEMPS', nf90_float, [ntim], id_tim) 622 #endif 619 ierr = nf90_def_var(nid, 'TEMPS', nf90_format, [ntim], id_tim) 623 620 ierr = nf_put_att_text(nid, id_tim, 'title', 17, 'Jour dans l annee') 624 621 625 #ifdef NC_DOUBLE 626 ierr = nf90_def_var(nid, 'NAT', nf90_double, dims, id_nat) 627 #else 628 ierr = nf90_def_var(nid, 'NAT', nf90_float, dims, id_nat) 629 #endif 622 ierr = nf90_def_var(nid, 'NAT', nf90_format, dims, id_nat) 630 623 ierr = nf_put_att_text(nid, id_nat, 'title', 23, & 631 624 'Nature du sol (0,1,2,3)') 632 625 633 #ifdef NC_DOUBLE 634 ierr = nf90_def_var(nid, 'SST', nf90_double, dims, id_sst) 635 #else 636 ierr = nf90_def_var(nid, 'SST', nf90_float, dims, id_sst) 637 #endif 626 ierr = nf90_def_var(nid, 'SST', nf90_format, dims, id_sst) 638 627 ierr = nf_put_att_text(nid, id_sst, 'title', 35, & 639 628 'Temperature superficielle de la mer') 640 629 641 #ifdef NC_DOUBLE 642 ierr = nf90_def_var(nid, 'BILS', nf90_double, dims, id_bils) 643 #else 644 ierr = nf90_def_var(nid, 'BILS', nf90_float, dims, id_bils) 645 #endif 630 ierr = nf90_def_var(nid, 'BILS', nf90_format, dims, id_bils) 646 631 ierr = nf_put_att_text(nid, id_bils, 'title', 32, & 647 632 'Reference flux de chaleur au sol') 648 633 649 #ifdef NC_DOUBLE 650 ierr = nf90_def_var(nid, 'ALB', nf90_double, dims, id_alb) 651 #else 652 ierr = nf90_def_var(nid, 'ALB', nf90_float, dims, id_alb) 653 #endif 634 ierr = nf90_def_var(nid, 'ALB', nf90_format, dims, id_alb) 654 635 ierr = nf_put_att_text(nid, id_alb, 'title', 19, 'Albedo a la surface') 655 636 656 #ifdef NC_DOUBLE 657 ierr = nf90_def_var(nid, 'RUG', nf90_double, dims, id_rug) 658 #else 659 ierr = nf90_def_var(nid, 'RUG', nf90_float, dims, id_rug) 660 #endif 637 ierr = nf90_def_var(nid, 'RUG', nf90_format, dims, id_rug) 661 638 ierr = nf_put_att_text(nid, id_rug, 'title', 8, 'Rugosite') 662 639 663 #ifdef NC_DOUBLE 664 ierr = nf90_def_var(nid, 'FTER', nf90_double, dims, id_fter) 665 #else 666 ierr = nf90_def_var(nid, 'FTER', nf90_float, dims, id_fter) 667 #endif 640 ierr = nf90_def_var(nid, 'FTER', nf90_format, dims, id_fter) 668 641 ierr = nf_put_att_text(nid, id_fter, 'title',10,'Frac. Land') 669 #ifdef NC_DOUBLE 670 ierr = nf90_def_var(nid, 'FOCE', nf90_double, dims, id_foce) 671 #else 672 ierr = nf90_def_var(nid, 'FOCE', nf90_float, dims, id_foce) 673 #endif 642 ierr = nf90_def_var(nid, 'FOCE', nf90_format, dims, id_foce) 674 643 ierr = nf_put_att_text(nid, id_foce, 'title',11,'Frac. Ocean') 675 #ifdef NC_DOUBLE 676 ierr = nf90_def_var(nid, 'FSIC', nf90_double, dims, id_fsic) 677 #else 678 ierr = nf90_def_var(nid, 'FSIC', nf90_float, dims, id_fsic) 679 #endif 644 ierr = nf90_def_var(nid, 'FSIC', nf90_format, dims, id_fsic) 680 645 ierr = nf_put_att_text(nid, id_fsic, 'title',13,'Frac. Sea Ice') 681 #ifdef NC_DOUBLE 682 ierr = nf90_def_var(nid, 'FLIC', nf90_double, dims, id_flic) 683 #else 684 ierr = nf90_def_var(nid, 'FLIC', nf90_float, dims, id_flic) 685 #endif 646 ierr = nf90_def_var(nid, 'FLIC', nf90_format, dims, id_flic) 686 647 ierr = nf_put_att_text(nid, id_flic, 'title',14,'Frac. Land Ice') 687 648 … … 695 656 ! write the 'times' 696 657 DO k = 1, year_len 697 #ifdef NC_DOUBLE 698 ierr = nf_put_var1_double(nid, id_tim, k, dble(k)) 699 #else 700 ierr = nf_put_var1_real(nid, id_tim, k, float(k)) 701 #endif 658 ierr = nf90_put_var(nid, id_tim, k, [k]) 702 659 IF (ierr/=nf_noerr) THEN 703 660 WRITE (*, *) 'writelim error with temps(k),k=', k … … 712 669 CALL gather(phy_nat, phy_glo) 713 670 IF (is_master) THEN 714 #ifdef NC_DOUBLE 715 ierr = nf_put_var_double(nid, id_nat, phy_glo) 716 #else 717 ierr = nf_put_var_real(nid, id_nat, phy_glo) 718 #endif 671 ierr = nf90_put_var(nid, id_nat, phy_glo) 719 672 IF (ierr/=nf_noerr) THEN 720 673 WRITE (*, *) 'writelim error with phy_nat' … … 725 678 CALL gather(phy_sst, phy_glo) 726 679 IF (is_master) THEN 727 #ifdef NC_DOUBLE 728 ierr = nf_put_var_double(nid, id_sst, phy_glo) 729 #else 730 ierr = nf_put_var_real(nid, id_sst, phy_glo) 731 #endif 680 ierr = nf90_put_var(nid, id_sst, phy_glo) 732 681 IF (ierr/=nf_noerr) THEN 733 682 WRITE (*, *) 'writelim error with phy_sst' … … 738 687 CALL gather(phy_bil, phy_glo) 739 688 IF (is_master) THEN 740 #ifdef NC_DOUBLE 741 ierr = nf_put_var_double(nid, id_bils, phy_glo) 742 #else 743 ierr = nf_put_var_real(nid, id_bils, phy_glo) 744 #endif 689 ierr = nf90_put_var(nid, id_bils, phy_glo) 745 690 IF (ierr/=nf_noerr) THEN 746 691 WRITE (*, *) 'writelim error with phy_bil' … … 751 696 CALL gather(phy_alb, phy_glo) 752 697 IF (is_master) THEN 753 #ifdef NC_DOUBLE 754 ierr = nf_put_var_double(nid, id_alb, phy_glo) 755 #else 756 ierr = nf_put_var_real(nid, id_alb, phy_glo) 757 #endif 698 ierr = nf90_put_var(nid, id_alb, phy_glo) 758 699 IF (ierr/=nf_noerr) THEN 759 700 WRITE (*, *) 'writelim error with phy_alb' … … 764 705 CALL gather(phy_rug, phy_glo) 765 706 IF (is_master) THEN 766 #ifdef NC_DOUBLE 767 ierr = nf_put_var_double(nid, id_rug, phy_glo) 768 #else 769 ierr = nf_put_var_real(nid, id_rug, phy_glo) 770 #endif 707 ierr = nf90_put_var(nid, id_rug, phy_glo) 771 708 IF (ierr/=nf_noerr) THEN 772 709 WRITE (*, *) 'writelim error with phy_rug' … … 777 714 CALL gather(phy_fter, phy_glo) 778 715 IF (is_master) THEN 779 #ifdef NC_DOUBLE 780 ierr = nf_put_var_double(nid, id_fter, phy_glo) 781 #else 782 ierr = nf_put_var_real(nid, id_fter, phy_glo) 783 #endif 716 ierr = nf90_put_var(nid, id_fter, phy_glo) 784 717 IF (ierr/=nf_noerr) THEN 785 718 WRITE (*, *) 'writelim error with phy_fter' … … 790 723 CALL gather(phy_foce, phy_glo) 791 724 IF (is_master) THEN 792 #ifdef NC_DOUBLE 793 ierr = nf_put_var_double(nid, id_foce, phy_glo) 794 #else 795 ierr = nf_put_var_real(nid, id_foce, phy_glo) 796 #endif 725 ierr = nf90_put_var(nid, id_foce, phy_glo) 797 726 IF (ierr/=nf_noerr) THEN 798 727 WRITE (*, *) 'writelim error with phy_foce' … … 803 732 CALL gather(phy_fsic, phy_glo) 804 733 IF (is_master) THEN 805 #ifdef NC_DOUBLE 806 ierr = nf_put_var_double(nid, id_fsic, phy_glo) 807 #else 808 ierr = nf_put_var_real(nid, id_fsic, phy_glo) 809 #endif 734 ierr = nf90_put_var(nid, id_fsic, phy_glo) 810 735 IF (ierr/=nf_noerr) THEN 811 736 WRITE (*, *) 'writelim error with phy_fsic' … … 816 741 CALL gather(phy_flic, phy_glo) 817 742 IF (is_master) THEN 818 #ifdef NC_DOUBLE 819 ierr = nf_put_var_double(nid, id_flic, phy_glo) 820 #else 821 ierr = nf_put_var_real(nid, id_flic, phy_glo) 822 #endif 743 ierr = nf90_put_var(nid, id_flic, phy_glo) 823 744 IF (ierr/=nf_noerr) THEN 824 745 WRITE (*, *) 'writelim error with phy_flic' -
LMDZ6/trunk/libf/phylmd/read_pstoke0.F90
r5084 r5249 270 270 ! **** Geopotentiel au sol *************************************** 271 271 ! phis 272 #ifdef NC_DOUBLE 273 status = nf_get_vara_double(ncidp, varidps, start, count, phisfi2) 274 #else 275 status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2) 276 #endif 272 status = nf90_get_var(ncidp, varidps, phisfi2, start, count) 277 273 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi) 278 274 279 275 ! **** Aires des mails aux sol ************************************ 280 276 ! aire 281 #ifdef NC_DOUBLE 282 status = nf_get_vara_double(ncidp, varidai, start, count, airefi2) 283 #else 284 status = nf_get_vara_real(ncidp, varidai, start, count, airefi2) 285 #endif 277 status = nf90_get_var(ncidp, varidai, airefi2, start, count) 286 278 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, airefi2, airefi) 287 279 ELSE … … 310 302 311 303 ! abder t 312 #ifdef NC_DOUBLE 313 status = nf_get_vara_double(ncidp, varidt, start, count, t2) 314 #else 315 status = nf_get_vara_real(ncidp, varidt, start, count, t2) 316 #endif 304 status = nf90_get_var(ncidp, varidt, t2, start, count) 317 305 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t) 318 306 … … 320 308 ! ******************************************** 321 309 ! mfu 322 #ifdef NC_DOUBLE 323 status = nf_get_vara_double(ncidp, varidmfu, start, count, mfu2) 324 #else 325 status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2) 326 #endif 310 status = nf90_get_var(ncidp, varidmfu, mfu2, start, count) 327 311 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu) 328 312 329 313 ! mfd 330 #ifdef NC_DOUBLE 331 status = nf_get_vara_double(ncidp, varidmfd, start, count, mfd2) 332 #else 333 status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2) 334 #endif 314 status = nf90_get_var(ncidp, varidmfd, mfd2, start, count) 335 315 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd) 336 316 337 317 ! en_u 338 #ifdef NC_DOUBLE 339 status = nf_get_vara_double(ncidp, varidenu, start, count, en_u2) 340 #else 341 status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2) 342 #endif 318 status = nf90_get_var(ncidp, varidenu, en_u2, start, count) 343 319 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u) 344 320 345 321 ! de_u 346 #ifdef NC_DOUBLE 347 status = nf_get_vara_double(ncidp, variddeu, start, count, de_u2) 348 #else 349 status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2) 350 #endif 322 status = nf90_get_var(ncidp, variddeu, de_u2, start, count) 351 323 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u) 352 324 353 325 ! en_d 354 #ifdef NC_DOUBLE 355 status = nf_get_vara_double(ncidp, varidend, start, count, en_d2) 356 #else 357 status = nf_get_vara_real(ncidp, varidend, start, count, en_d2) 358 #endif 326 status = nf90_get_var(ncidp, varidend, en_d2, start, count) 359 327 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d) 360 328 361 329 ! de_d 362 #ifdef NC_DOUBLE 363 status = nf_get_vara_double(ncidp, varidded, start, count, de_d2) 364 #else 365 status = nf_get_vara_real(ncidp, varidded, start, count, de_d2) 366 #endif 330 status = nf90_get_var(ncidp, varidded, de_d2, start, count) 367 331 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d) 368 332 … … 371 335 ! coefh 372 336 PRINT *, 'LECTURE de coefh a irec =', irec 373 #ifdef NC_DOUBLE 374 status = nf_get_vara_double(ncidp, varidch, start, count, coefh2) 375 #else 376 status = nf_get_vara_real(ncidp, varidch, start, count, coefh2) 377 #endif 337 status = nf90_get_var(ncidp, varidch, coefh2, start, count) 378 338 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh) 379 339 ! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ ') … … 384 344 ! Thermiques 385 345 PRINT *, 'LECTURE de fm_therm a irec =', irec 386 #ifdef NC_DOUBLE 387 status = nf_get_vara_double(ncidp, varidfmth, start, count, fm_therm2) 388 #else 389 status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2) 390 #endif 346 status = nf90_get_var(ncidp, varidfmth, fm_therm2, start, count) 391 347 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm) 392 348 PRINT *, 'LECTURE de en_therm a irec =', irec 393 #ifdef NC_DOUBLE 394 status = nf_get_vara_double(ncidp, varidenth, start, count, en_therm2) 395 #else 396 status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2) 397 #endif 349 status = nf90_get_var(ncidp, varidenth, en_therm2, start, count) 398 350 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm) 399 351 … … 401 353 ! ******************************************* 402 354 ! frac_impa 403 #ifdef NC_DOUBLE 404 status = nf_get_vara_double(ncidp, varidfi, start, count, frac_impa2) 405 #else 406 status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2) 407 #endif 355 status = nf90_get_var(ncidp, varidfi, frac_impa2, start, count) 408 356 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa) 409 357 410 358 ! frac_nucl 411 359 412 #ifdef NC_DOUBLE 413 status = nf_get_vara_double(ncidp, varidfn, start, count, frac_nucl2) 414 #else 415 status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2) 416 #endif 360 status = nf90_get_var(ncidp, varidfn, frac_nucl2, start, count) 417 361 CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl) 418 362 … … 426 370 ! pyu1 427 371 PRINT *, 'LECTURE de yu1 a irec =', irec 428 #ifdef NC_DOUBLE 429 status = nf_get_vara_double(ncidp, varidyu1, start, count, pyu12) 430 #else 431 status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12) 432 #endif 372 status = nf90_get_var(ncidp, varidyu1, pyu12, start, count) 433 373 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1) 434 374 435 375 ! pyv1 436 376 PRINT *, 'LECTURE de yv1 a irec =', irec 437 #ifdef NC_DOUBLE 438 status = nf_get_vara_double(ncidp, varidyv1, start, count, pyv12) 439 #else 440 status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12) 441 #endif 377 status = nf90_get_var(ncidp, varidyv1, pyv12, start, count) 442 378 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1) 443 379 … … 445 381 ! ftsol1 446 382 PRINT *, 'LECTURE de ftsol1 a irec =', irec 447 #ifdef NC_DOUBLE 448 status = nf_get_vara_double(ncidp, varidfts1, start, count, ftsol12) 449 #else 450 status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12) 451 #endif 383 status = nf90_get_var(ncidp, varidfts1, ftsol12, start, count) 452 384 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1) 453 385 454 386 ! ftsol2 455 387 PRINT *, 'LECTURE de ftsol2 a irec =', irec 456 #ifdef NC_DOUBLE 457 status = nf_get_vara_double(ncidp, varidfts2, start, count, ftsol22) 458 #else 459 status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22) 460 #endif 388 status = nf90_get_var(ncidp, varidfts2, ftsol22, start, count) 461 389 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2) 462 390 463 391 ! ftsol3 464 392 PRINT *, 'LECTURE de ftsol3 a irec =', irec 465 #ifdef NC_DOUBLE 466 status = nf_get_vara_double(ncidp, varidfts3, start, count, ftsol32) 467 #else 468 status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32) 469 #endif 393 status = nf90_get_var(ncidp, varidfts3, ftsol32, start, count) 470 394 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3) 471 395 472 396 ! ftsol4 473 #ifdef NC_DOUBLE 474 status = nf_get_vara_double(ncidp, varidfts4, start, count, ftsol42) 475 #else 476 status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42) 477 #endif 397 status = nf90_get_var(ncidp, varidfts4, ftsol42, start, count) 478 398 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4) 479 399 480 400 ! **** Nature sol ******************************************** 481 401 ! psrf1 482 #ifdef NC_DOUBLE 483 status = nf_get_vara_double(ncidp, varidpsr1, start, count, psrf12) 484 #else 485 status = nf_get_vara_real(ncidp, varidpsr1, start, count, psrf12) 486 #endif 402 status = nf90_get_var(ncidp, varidpsr1, psrf12, start, count) 487 403 ! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC') 488 404 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1) 489 405 490 406 ! psrf2 491 #ifdef NC_DOUBLE 492 status = nf_get_vara_double(ncidp, varidpsr2, start, count, psrf22) 493 #else 494 status = nf_get_vara_real(ncidp, varidpsr2, start, count, psrf22) 495 #endif 407 status = nf90_get_var(ncidp, varidpsr2, psrf22, start, count) 496 408 ! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC') 497 409 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2) 498 410 499 411 ! psrf3 500 #ifdef NC_DOUBLE 501 status = nf_get_vara_double(ncidp, varidpsr3, start, count, psrf32) 502 #else 503 status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32) 504 #endif 412 status = nf90_get_var(ncidp, varidpsr3, psrf32, start, count) 505 413 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3) 506 414 507 415 ! psrf4 508 #ifdef NC_DOUBLE 509 status = nf_get_vara_double(ncidp, varidpsr4, start, count, psrf42) 510 #else 511 status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42) 512 #endif 416 status = nf90_get_var(ncidp, varidpsr4, psrf42, start, count) 513 417 CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4) 514 418 -
LMDZ6/trunk/libf/phylmdiso/phyaqua_mod.F90
r5084 r5249 593 593 USE mod_phys_lmdz_transfert_para, ONLY: gather 594 594 USE phys_cal_mod, ONLY: year_len 595 USE netcdf, ONLY: nf90_put_var, nf90_def_var 596 USE lmdz_cppkeys_wrapper, ONLY: nf90_format 595 597 IMPLICIT NONE 596 598 include "netcdf.inc" … … 636 638 dims(2) = ntim 637 639 638 #ifdef NC_DOUBLE 639 ierr = nf_def_var(nid, 'TEMPS', nf_double, 1, ntim, id_tim) 640 #else 641 ierr = nf_def_var(nid, 'TEMPS', nf_float, 1, ntim, id_tim) 642 #endif 640 ierr = nf90_def_var(nid, 'TEMPS', nf90_format, ntim, id_tim) 643 641 ierr = nf_put_att_text(nid, id_tim, 'title', 17, 'Jour dans l annee') 644 642 645 #ifdef NC_DOUBLE 646 ierr = nf_def_var(nid, 'NAT', nf_double, 2, dims, id_nat) 647 #else 648 ierr = nf_def_var(nid, 'NAT', nf_float, 2, dims, id_nat) 649 #endif 643 ierr = nf90_def_var(nid, 'NAT', nf90_format, dims, id_nat) 650 644 ierr = nf_put_att_text(nid, id_nat, 'title', 23, & 651 645 'Nature du sol (0,1,2,3)') 652 646 653 #ifdef NC_DOUBLE 654 ierr = nf_def_var(nid, 'SST', nf_double, 2, dims, id_sst) 655 #else 656 ierr = nf_def_var(nid, 'SST', nf_float, 2, dims, id_sst) 657 #endif 647 ierr = nf90_def_var(nid, 'SST', nf90_format, dims, id_sst) 658 648 ierr = nf_put_att_text(nid, id_sst, 'title', 35, & 659 649 'Temperature superficielle de la mer') 660 650 661 #ifdef NC_DOUBLE 662 ierr = nf_def_var(nid, 'BILS', nf_double, 2, dims, id_bils) 663 #else 664 ierr = nf_def_var(nid, 'BILS', nf_float, 2, dims, id_bils) 665 #endif 651 ierr = nf90_def_var(nid, 'BILS', nf90_format, dims, id_bils) 666 652 ierr = nf_put_att_text(nid, id_bils, 'title', 32, & 667 653 'Reference flux de chaleur au sol') 668 654 669 #ifdef NC_DOUBLE 670 ierr = nf_def_var(nid, 'ALB', nf_double, 2, dims, id_alb) 671 #else 672 ierr = nf_def_var(nid, 'ALB', nf_float, 2, dims, id_alb) 673 #endif 655 ierr = nf90_def_var(nid, 'ALB', nf90_format, dims, id_alb) 674 656 ierr = nf_put_att_text(nid, id_alb, 'title', 19, 'Albedo a la surface') 675 657 676 #ifdef NC_DOUBLE 677 ierr = nf_def_var(nid, 'RUG', nf_double, 2, dims, id_rug) 678 #else 679 ierr = nf_def_var(nid, 'RUG', nf_float, 2, dims, id_rug) 680 #endif 658 ierr = nf90_def_var(nid, 'RUG', nf90_format, dims, id_rug) 681 659 ierr = nf_put_att_text(nid, id_rug, 'title', 8, 'Rugosite') 682 660 683 #ifdef NC_DOUBLE 684 ierr = nf_def_var(nid, 'FTER', nf_double, 2, dims, id_fter) 685 #else 686 ierr = nf_def_var(nid, 'FTER', nf_float, 2, dims, id_fter) 687 #endif 661 ierr = nf90_def_var(nid, 'FTER', nf90_format, dims, id_fter) 688 662 ierr = nf_put_att_text(nid, id_fter, 'title',10,'Frac. Land') 689 #ifdef NC_DOUBLE 690 ierr = nf_def_var(nid, 'FOCE', nf_double, 2, dims, id_foce) 691 #else 692 ierr = nf_def_var(nid, 'FOCE', nf_float, 2, dims, id_foce) 693 #endif 663 ierr = nf90_def_var(nid, 'FOCE', nf90_format, dims, id_foce) 694 664 ierr = nf_put_att_text(nid, id_foce, 'title',11,'Frac. Ocean') 695 #ifdef NC_DOUBLE 696 ierr = nf_def_var(nid, 'FSIC', nf_double, 2, dims, id_fsic) 697 #else 698 ierr = nf_def_var(nid, 'FSIC', nf_float, 2, dims, id_fsic) 699 #endif 665 ierr = nf90_def_var(nid, 'FSIC', nf90_format, dims, id_fsic) 700 666 ierr = nf_put_att_text(nid, id_fsic, 'title',13,'Frac. Sea Ice') 701 #ifdef NC_DOUBLE 702 ierr = nf_def_var(nid, 'FLIC', nf_double, 2, dims, id_flic) 703 #else 704 ierr = nf_def_var(nid, 'FLIC', nf_float, 2, dims, id_flic) 705 #endif 667 ierr = nf90_def_var(nid, 'FLIC', nf90_format, dims, id_flic) 706 668 ierr = nf_put_att_text(nid, id_flic, 'title',14,'Frac. Land Ice') 707 669 … … 715 677 ! write the 'times' 716 678 DO k = 1, year_len 717 #ifdef NC_DOUBLE 718 ierr = nf_put_var1_double(nid, id_tim, k, dble(k)) 719 #else 720 ierr = nf_put_var1_real(nid, id_tim, k, float(k)) 721 #endif 679 ierr = nf90_put_var(nid, id_tim, k, [k]) 722 680 IF (ierr/=nf_noerr) THEN 723 681 WRITE (*, *) 'writelim error with temps(k),k=', k … … 732 690 CALL gather(phy_nat, phy_glo) 733 691 IF (is_master) THEN 734 #ifdef NC_DOUBLE 735 ierr = nf_put_var_double(nid, id_nat, phy_glo) 736 #else 737 ierr = nf_put_var_real(nid, id_nat, phy_glo) 738 #endif 692 ierr = nf90_put_var(nid, id_nat, phy_glo) 739 693 IF (ierr/=nf_noerr) THEN 740 694 WRITE (*, *) 'writelim error with phy_nat' … … 745 699 CALL gather(phy_sst, phy_glo) 746 700 IF (is_master) THEN 747 #ifdef NC_DOUBLE 748 ierr = nf_put_var_double(nid, id_sst, phy_glo) 749 #else 750 ierr = nf_put_var_real(nid, id_sst, phy_glo) 751 #endif 701 ierr = nf90_put_var(nid, id_sst, phy_glo) 752 702 IF (ierr/=nf_noerr) THEN 753 703 WRITE (*, *) 'writelim error with phy_sst' … … 758 708 CALL gather(phy_bil, phy_glo) 759 709 IF (is_master) THEN 760 #ifdef NC_DOUBLE 761 ierr = nf_put_var_double(nid, id_bils, phy_glo) 762 #else 763 ierr = nf_put_var_real(nid, id_bils, phy_glo) 764 #endif 710 ierr = nf90_put_var(nid, id_bils, phy_glo) 765 711 IF (ierr/=nf_noerr) THEN 766 712 WRITE (*, *) 'writelim error with phy_bil' … … 771 717 CALL gather(phy_alb, phy_glo) 772 718 IF (is_master) THEN 773 #ifdef NC_DOUBLE 774 ierr = nf_put_var_double(nid, id_alb, phy_glo) 775 #else 776 ierr = nf_put_var_real(nid, id_alb, phy_glo) 777 #endif 719 ierr = nf90_put_var(nid, id_alb, phy_glo) 778 720 IF (ierr/=nf_noerr) THEN 779 721 WRITE (*, *) 'writelim error with phy_alb' … … 784 726 CALL gather(phy_rug, phy_glo) 785 727 IF (is_master) THEN 786 #ifdef NC_DOUBLE 787 ierr = nf_put_var_double(nid, id_rug, phy_glo) 788 #else 789 ierr = nf_put_var_real(nid, id_rug, phy_glo) 790 #endif 728 ierr = nf90_put_var(nid, id_rug, phy_glo) 791 729 IF (ierr/=nf_noerr) THEN 792 730 WRITE (*, *) 'writelim error with phy_rug' … … 797 735 CALL gather(phy_fter, phy_glo) 798 736 IF (is_master) THEN 799 #ifdef NC_DOUBLE 800 ierr = nf_put_var_double(nid, id_fter, phy_glo) 801 #else 802 ierr = nf_put_var_real(nid, id_fter, phy_glo) 803 #endif 737 ierr = nf90_put_var(nid, id_fter, phy_glo) 804 738 IF (ierr/=nf_noerr) THEN 805 739 WRITE (*, *) 'writelim error with phy_fter' … … 810 744 CALL gather(phy_foce, phy_glo) 811 745 IF (is_master) THEN 812 #ifdef NC_DOUBLE 813 ierr = nf_put_var_double(nid, id_foce, phy_glo) 814 #else 815 ierr = nf_put_var_real(nid, id_foce, phy_glo) 816 #endif 746 ierr = nf90_put_var(nid, id_foce, phy_glo) 817 747 IF (ierr/=nf_noerr) THEN 818 748 WRITE (*, *) 'writelim error with phy_foce' … … 823 753 CALL gather(phy_fsic, phy_glo) 824 754 IF (is_master) THEN 825 #ifdef NC_DOUBLE 826 ierr = nf_put_var_double(nid, id_fsic, phy_glo) 827 #else 828 ierr = nf_put_var_real(nid, id_fsic, phy_glo) 829 #endif 755 ierr = nf90_put_var(nid, id_fsic, phy_glo) 830 756 IF (ierr/=nf_noerr) THEN 831 757 WRITE (*, *) 'writelim error with phy_fsic' … … 836 762 CALL gather(phy_flic, phy_glo) 837 763 IF (is_master) THEN 838 #ifdef NC_DOUBLE 839 ierr = nf_put_var_double(nid, id_flic, phy_glo) 840 #else 841 ierr = nf_put_var_real(nid, id_flic, phy_glo) 842 #endif 764 ierr = nf90_put_var(nid, id_flic, phy_glo) 843 765 IF (ierr/=nf_noerr) THEN 844 766 WRITE (*, *) 'writelim error with phy_flic'
Note: See TracChangeset
for help on using the changeset viewer.
