Ignore:
Timestamp:
Nov 29, 2013, 9:40:25 AM (11 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r1860:1909 into testing branch

Location:
LMDZ5/branches/testing
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf

    • Property copyright set to
      Name of program: LMDZ
      Creation date: 1984
      Version: LMDZ5
      License: CeCILL version 2
      Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
      See the license file in the root directory

  • LMDZ5/branches/testing/libf/phylmd

    • Property copyright set to
      Name of program: LMDZ
      Creation date: 1984
      Version: LMDZ5
      License: CeCILL version 2
      Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
      See the license file in the root directory

  • LMDZ5/branches/testing/libf/phylmd/iophy.F90

    • Property copyright set to
      Name of program: LMDZ
      Creation date: 1984
      Version: LMDZ5
      License: CeCILL version 2
      Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
      See the license file in the root directory
    r1864 r1910  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44MODULE iophy
    5 
    6   USE phys_output_var_mod
    7 #ifdef CPP_XIOS
    8   USE wxios
    9 #endif
    10 
    11 #ifdef CPP_XIOS
    12   USE wxios
    13 #endif
    145
    156! abd  REAL,private,allocatable,DIMENSION(:),save :: io_lat
    … …  
    4940
    5041  SUBROUTINE init_iophy_new(rlat,rlon)
    51   USE dimphy
    52   USE mod_phys_lmdz_para
    53   USE mod_grid_phy_lmdz
    54   USE ioipsl
    55 
     42  USE dimphy, only: klon
     43  USE mod_phys_lmdz_para, only: gather, bcast, &
     44                                jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
     45                                mpi_size, mpi_rank, klon_mpi, &
     46                                is_sequential, is_south_pole
     47  USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
     48#ifdef CPP_IOIPSL
     49  USE ioipsl, only: flio_dom_set
     50#endif
     51#ifdef CPP_XIOS
     52  use wxios, only: wxios_domain_param
     53#endif
    5654  IMPLICIT NONE
    57   INCLUDE 'dimensions.h'   
     55  INCLUDE 'dimensions.h'
     56  include 'iniprint.h'
    5857    REAL,DIMENSION(klon),INTENT(IN) :: rlon
    5958    REAL,DIMENSION(klon),INTENT(IN) :: rlat
    … …  
    121120#endif
    122121#ifdef CPP_XIOS
    123     !Pour els soucis en MPI, réglage du masque:
     122    ! Set values for the mask:
    124123    IF (mpi_rank == 0) THEN
    125124        data_ibegin = 0
    … …  
    134133    END IF
    135134
    136     WRITE(*,*) "TOTO mpirank=",mpi_rank,"iibeg=",ii_begin , "jjbeg=",jj_begin,"jjnb=",jj_nb,"jjend=",jj_end
    137 
    138     !On initialise le domaine xios, maintenant que tout est connu:
    139     !SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo,        &
    140     !                                ibegin, iend, jbegin, jend,                         &
    141     !                                data_ni, data_ibegin,                               &
    142     !                                io_lat, io_lon)
     135    if (prt_level>=10) then
     136      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
     137      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
     138      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
     139      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
     140      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole
     141    endif
     142
     143    ! Initialize the XIOS domain coreesponding to this process:
    143144    CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
    144145                            1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
    145146                            klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
    146                             io_lat, io_lon)
     147                            io_lat, io_lon,is_south_pole,mpi_rank)
    147148#endif
    148149!$OMP END MASTER
    … …  
    151152
    152153  SUBROUTINE init_iophy(lat,lon)
    153   USE dimphy
    154   USE mod_phys_lmdz_para
    155   USE ioipsl
     154  USE mod_phys_lmdz_para, only: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
     155                                mpi_size, mpi_rank
     156  USE ioipsl, only: flio_dom_set
    156157  IMPLICIT NONE
    157158  INCLUDE 'dimensions.h'   
    … …  
    194195
    195196 SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
    196   USE dimphy
    197   USE mod_phys_lmdz_para
    198   use ioipsl
    199   use write_field
     197!  USE dimphy
     198  USE mod_phys_lmdz_para, only: is_sequential, is_using_mpi, is_mpi_root, &
     199                                jj_begin, jj_end, jj_nb
     200  use ioipsl, only: histbeg
     201#ifdef CPP_XIOS
     202  use wxios, only: wxios_add_file
     203#endif
    200204  IMPLICIT NONE
    201205  include 'dimensions.h'
    … …  
    231235 
    232236  SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
    233   USE dimphy
    234   USE mod_phys_lmdz_para
    235   use ioipsl
    236   use write_field
     237
     238  USE mod_phys_lmdz_para, only: jj_begin, jj_end, jj_nb, is_sequential
     239  use ioipsl, only: histbeg
     240
    237241  IMPLICIT NONE
    238242  include 'dimensions.h'
    … …  
    263267             plon,plat,plon_bounds,plat_bounds, &
    264268             nname,itau0,zjulian,dtime,nnhori,nnid_day)
    265   USE dimphy
    266   USE mod_phys_lmdz_para
    267   USE mod_grid_phy_lmdz
    268   use ioipsl
    269   use write_field
     269  USE dimphy, only: klon
     270  USE mod_phys_lmdz_para, only: gather, bcast, &
     271                                is_sequential, klon_mpi_begin, klon_mpi_end, &
     272                                mpi_rank
     273  USE mod_grid_phy_lmdz, only: klon_glo
     274  use ioipsl, only: histbeg
     275
    270276  IMPLICIT NONE
    271277  include 'dimensions.h'
    … …  
    383389!
    384390    ENDDO
    385 !    print*,'iophy is_sequential nname, nnhori, nnid_day=',trim(nname),nnhori,nnid_day
     391
    386392#ifndef CPP_NO_IOIPSL
    387393     call histbeg(nname,pim,plon,plon_bounds, &
    … …  
    438444  SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
    439445
    440     USE ioipsl
    441     USE dimphy
    442     USE mod_phys_lmdz_para
    443 
     446    USE ioipsl, only: histdef
     447    USE mod_phys_lmdz_para, only: jj_nb
     448    use phys_output_var_mod, only: type_ecri, zoutm, zdtime_moy, lev_files, &
     449                                   nid_files, nhorim, swaero_diag, nfiles
    444450    IMPLICIT NONE
    445451
    … …  
    492498  SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
    493499
    494     USE ioipsl
    495     USE dimphy
    496     USE mod_phys_lmdz_para
    497 
     500    USE ioipsl, only: histdef
     501    USE dimphy, only: klev
     502    USE mod_phys_lmdz_para, only: jj_nb
     503    use phys_output_var_mod, only: type_ecri, zoutm, lev_files, nid_files, &
     504                                   nhorim, zdtime_moy, levmin, levmax, &
     505                                   nvertm, nfiles
    498506    IMPLICIT NONE
    499507
    … …  
    547555  SUBROUTINE histdef2d (iff,var)
    548556
    549     USE ioipsl
    550     USE dimphy
    551     USE mod_phys_lmdz_para
    552 
     557    USE ioipsl, only: histdef
     558    USE mod_phys_lmdz_para, only: jj_nb
     559    use phys_output_var_mod, only: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
     560                                   clef_stations, phys_out_filenames, lev_files, &
     561                                   nid_files, nhorim, swaero_diag
     562#ifdef CPP_XIOS
     563    use wxios, only: wxios_add_field_to_file
     564#endif
    553565    IMPLICIT NONE
    554566
    … …  
    618630  SUBROUTINE histdef3d (iff,var)
    619631
    620     USE ioipsl
    621     USE dimphy
    622     USE mod_phys_lmdz_para
    623 
     632    USE ioipsl, only: histdef
     633    USE dimphy, only: klev
     634    USE mod_phys_lmdz_para, only: jj_nb
     635    use phys_output_var_mod, only: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
     636                                   clef_stations, phys_out_filenames, lev_files, &
     637                                   nid_files, nhorim, swaero_diag, levmin, &
     638                                   levmax, nvertm
     639#ifdef CPP_XIOS
     640    use wxios, only: wxios_add_field_to_file
     641#endif
    624642    IMPLICIT NONE
    625643
    … …  
    686704!!! Lecture des noms et niveau de sortie des variables dans output.def
    687705    !   en utilisant les routines getin de IOIPSL 
    688     use ioipsl
    689 
     706    use ioipsl, only: getin
     707    use phys_output_var_mod, only: nfiles
    690708    IMPLICIT NONE
    691709
    … …  
    705723 
    706724  SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
    707   USE dimphy
    708   USE mod_phys_lmdz_para
    709   USE ioipsl
     725  USE dimphy, only: klon
     726  USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &
     727                                is_sequential, klon_mpi_begin, klon_mpi_end, &
     728                                jj_nb, klon_mpi
     729  USE ioipsl, only: histwrite
    710730  IMPLICIT NONE
    711731  include 'dimensions.h'
    … …  
    733753     ALLOCATE(index2d(iim*jj_nb))
    734754     ALLOCATE(fieldok(iim*jj_nb))
    735      IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL'
     755     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    736756     CALL histwrite(nid,name,itau,Field2d,iim*jj_nb,index2d)
    737      IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL'
     757     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    738758    else
    739759     ALLOCATE(fieldok(npstn))
    … …  
    755775      ENDDO
    756776     endif
    757      IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL'
     777     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    758778     CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
    759      IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL'
     779     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    760780!
    761781    endif
    … …  
    768788
    769789  SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
    770   USE dimphy
    771   USE mod_phys_lmdz_para
    772 
    773   use ioipsl
     790  USE dimphy, only: klon
     791  USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &
     792                                is_sequential, klon_mpi_begin, klon_mpi_end, &
     793                                jj_nb, klon_mpi
     794  use ioipsl, only: histwrite
    774795  IMPLICIT NONE
    775796  include 'dimensions.h'
    … …  
    791812    nlev=size(field,2)
    792813
    793 !   print*,'hist3d_phy mpi_rank npstn=',mpi_rank,npstn
    794 
    795 !   DO ip=1, npstn
    796 !    print*,'hist3d_phy mpi_rank nptabij',mpi_rank,nptabij(ip)
    797 !   ENDDO
    798 
    799814    CALL Gather_omp(field,buffer_omp)
    800815!$OMP MASTER
    … …  
    803818     ALLOCATE(index3d(iim*jj_nb*nlev))
    804819     ALLOCATE(fieldok(iim*jj_nb,nlev))
    805      IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL'
     820     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    806821     CALL histwrite(nid,name,itau,Field3d,iim*jj_nb*nlev,index3d)
    807      IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL'
     822     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    808823   else
    809824      nlev=size(field,2)
    … …  
    829844       ENDDO
    830845      endif
    831       IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL'
     846      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    832847      CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
    833       IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL'
     848      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    834849    endif
    835850  deallocate(index3d)
    … …  
    844859! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    845860  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
    846   USE dimphy
    847   USE mod_phys_lmdz_para
    848   USE ioipsl
    849  
    850 
    851 
    852 #ifdef CPP_XIOS
    853   USE wxios
     861  USE dimphy, only: klon
     862  USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &
     863                                jj_nb, klon_mpi, klon_mpi_begin, &
     864                                klon_mpi_end, is_sequential
     865  USE ioipsl, only: histwrite
     866  use phys_output_var_mod, only: ctrl_out, clef_files, lev_files, &
     867                                 nfiles, vars_defined, clef_stations, &
     868                                 nid_files
     869#ifdef CPP_XIOS
     870  USE wxios, only: wxios_write_2D
    854871#endif
    855872
    … …  
    872889    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
    873890
    874     IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
     891    IF (prt_level >= 10) WRITE(lunout,*)'Begin histwrite2d_phy ',trim(var%name)
    875892
    876893! ug RUSTINE POUR LES STD LEVS.....
    … …  
    896913
    897914    !Et sinon on.... écrit
    898     IF (SIZE(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
     915    IF (SIZE(field)/=klon) CALL abort_gcm('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon',1)
    899916   
    900     CALL Gather_omp(field,buffer_omp)   
     917    if (prt_level >= 10) then
     918      write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", &
     919                     trim(var%name)
     920    endif
     921   
     922    CALL Gather_omp(field,buffer_omp)
    901923!$OMP MASTER
    902924    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    903    
     925
    904926! La boucle sur les fichiers:
    905927      DO iff=iff_beg, iff_end
    … …  
    914936#ifdef CPP_XIOS
    915937                        IF (iff == iff_beg) THEN
    916                               CALL wxios_write_2D(var%name, Field2d)
     938                          if (prt_level >= 10) then
     939                            write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
     940                          endif
     941                          CALL wxios_write_2D(var%name, Field2d)
    917942                        ENDIF
    918943#endif
    … …  
    922947
    923948                        IF (is_sequential) THEN
     949                          DO ip=1, npstn
     950                            fieldok(ip)=buffer_omp(nptabij(ip))
     951                          ENDDO
     952                        ELSE
    924953                              DO ip=1, npstn
    925                                     fieldok(ip)=buffer_omp(nptabij(ip))
    926                               ENDDO
    927                              ELSE
    928                               DO ip=1, npstn
    929                                 PRINT*,'histwrite2d is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
     954                                write(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
    930955                                     IF(nptabij(ip).GE.klon_mpi_begin.AND. &
    931956                                        nptabij(ip).LE.klon_mpi_end) THEN
    … …  
    933958                                     ENDIF
    934959                              ENDDO
    935                        ENDIF
     960                       ENDIF ! of IF (is_sequential)
    936961#ifndef CPP_NO_IOIPSL
     962                       if (prt_level >= 10) then
     963                         write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
     964                       endif
    937965                       CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
    938966#endif
    939                   ENDIF
     967                  ENDIF ! of IF(.NOT.clef_stations(iff))
    940968                 
    941969                deallocate(index2d)
    942970                deallocate(fieldok)
    943971            ENDIF !levfiles
    944       ENDDO
     972      ENDDO ! of DO iff=iff_beg, iff_end
    945973!$OMP END MASTER   
    946974  ENDIF ! vars_defined
    947   IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d ',var%name
     975  IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name)
    948976  END SUBROUTINE histwrite2d_phy
    949977
    … …  
    951979! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    952980  SUBROUTINE histwrite3d_phy(var, field, STD_iff)
    953   USE dimphy
    954   USE mod_phys_lmdz_para
    955   USE ioipsl
    956  
    957 
    958 #ifdef CPP_XIOS
    959 ! USE WXIOS
     981  USE dimphy, only: klon, klev
     982  USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &
     983                                jj_nb, klon_mpi, klon_mpi_begin, &
     984                                klon_mpi_end, is_sequential
     985  USE ioipsl, only: histwrite
     986  use phys_output_var_mod, only: ctrl_out, clef_files, lev_files, &
     987                                 nfiles, vars_defined, clef_stations, &
     988                                 nid_files
     989#ifdef CPP_XIOS
     990  USE wxios, only: wxios_write_3D
    960991#endif
    961992
    … …  
    9771008    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    9781009
    979   IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name
     1010  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d ',var%name
    9801011
    9811012! ug RUSTINE POUR LES STD LEVS.....
    … …  
    10571088!$OMP END MASTER   
    10581089  ENDIF ! vars_defined
    1059   IF (prt_level >= 9) write(lunout,*)'End histrwrite3d ',var%name
     1090  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name
    10601091  END SUBROUTINE histwrite3d_phy
    10611092 
    … …  
    10641095#ifdef CPP_XIOS
    10651096  SUBROUTINE histwrite2d_xios(field_name,field)
    1066   USE dimphy
    1067   USE mod_phys_lmdz_para
    1068   USE wxios
     1097  USE dimphy, only: klon
     1098  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
     1099                                is_sequential, klon_mpi_begin, klon_mpi_end, &
     1100                                jj_nb, klon_mpi
     1101  USE wxios, only: wxios_write_2D
    10691102
    10701103
    … …  
    10831116    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
    10841117
    1085     IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
     1118    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
    10861119
    10871120    !Et sinon on.... écrit
    … …  
    11271160!$OMP END MASTER   
    11281161
    1129   IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
     1162  IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
    11301163  END SUBROUTINE histwrite2d_xios
    11311164
    … …  
    11331166! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    11341167  SUBROUTINE histwrite3d_xios(field_name, field)
    1135   USE dimphy
    1136   USE mod_phys_lmdz_para
    1137   USE wxios
     1168  USE dimphy, only: klon, klev
     1169  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
     1170                                is_sequential, klon_mpi_begin, klon_mpi_end, &
     1171                                jj_nb, klon_mpi
     1172  USE wxios, only: wxios_write_3D
    11381173
    11391174
    … …  
    11511186    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    11521187
    1153   IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d_xios ',field_name
     1188  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
    11541189
    11551190    !Et on.... écrit
    … …  
    11971232!$OMP END MASTER   
    11981233
    1199   IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_xios ',field_name
     1234  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
    12001235  END SUBROUTINE histwrite3d_xios
    12011236#endif
Note: See TracChangeset for help on using the changeset viewer.