Ignore:
Timestamp:
Aug 30, 2013, 10:47:10 AM (11 years ago)
Author:
Ehouarn Millour
Message:

Implémentation des sorties XIOS dans LMDZ. Activation via -cpp CPP_XIOS.
ATTENTION: un problème de raccord subsiste en mode MPI !
UG
................................
Adding XIOS output to LMDZ. Activated by the CPP_XIOS key.
WARNING: buggy for now in MPI mode.
UG

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/iophy.F90

    r1828 r1852  
    55
    66  USE phys_output_var_mod
     7#ifdef CPP_XIOS
     8  USE wxios
     9#endif
    710
    811#ifdef CPP_XIOS
    … …  
    2023
    2124!$OMP THREADPRIVATE(itau_iophy)
    22  
     25
     26#ifdef CPP_XIOS
     27  INTERFACE histwrite_phy
     28    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios
     29  END INTERFACE
     30#else
    2331  INTERFACE histwrite_phy
    2432    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old
    2533  END INTERFACE
     34#endif
    2635
    2736  INTERFACE histbeg_phy_all
    … …  
    4453  USE mod_grid_phy_lmdz
    4554  USE ioipsl
    46  
     55
    4756  IMPLICIT NONE
    4857  INCLUDE 'dimensions.h'   
    … …  
    6170    INTEGER,DIMENSION(2) :: dhe
    6271    INTEGER :: i   
     72    INTEGER :: data_ibegin, data_iend
    6373
    6474    CALL gather(rlat,rlat_glo)
    … …  
    7989    ALLOCATE(io_lon(iim))
    8090    io_lon(:)=rlon_glo(2-1/(iim*jjm):iim+1-1/(iim*jjm))
     91!! (I) dtnb   : total number of domains
     92!! (I) dnb    : domain number
     93!! (I) did(:) : distributed dimensions identifiers
     94!!              (up to 5 dimensions are supported)
     95!! (I) dsg(:) : total number of points for each dimension
     96!! (I) dsl(:) : local number of points for each dimension
     97!! (I) dpf(:) : position of first local point for each dimension
     98!! (I) dpl(:) : position of last local point for each dimension
     99!! (I) dhs(:) : start halo size for each dimension
     100!! (I) dhe(:) : end halo size for each dimension
     101!! (C) cdnm   : Model domain definition name.
     102!!              The names actually supported are :
     103!!              "BOX", "APPLE", "ORANGE".
     104!!              These names are case insensitive.
    81105
    82106    ddid=(/ 1,2 /)
    … …  
    91115      dhe=(/ iim-ii_end,0 /) 
    92116    ENDIF
    93    
     117
     118#ifndef CPP_NO_IOIPSL   
    94119    CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
    95120                      'APPLE',phys_domain_id)
     121#endif
    96122#ifdef CPP_XIOS
     123    !Pour els soucis en MPI, réglage du masque:
     124    IF (mpi_rank == 0) THEN
     125        data_ibegin = 0
     126    ELSE
     127        data_ibegin = ii_begin - 1
     128    END IF
     129
     130    IF (mpi_rank == mpi_size-1) THEN
     131        data_iend = nbp_lon
     132    ELSE
     133        data_iend = ii_end + 1
     134    END IF
     135
     136    WRITE(*,*) "TOTO mpirank=",mpi_rank,"iibeg=",ii_begin , "jjbeg=",jj_begin,"jjnb=",jj_nb,"jjend=",jj_end
     137
    97138    !On initialise le domaine xios, maintenant que tout est connu:
    98     CALL wxios_domain_param("dom_glo", is_sequential, iim, jjm+1, io_lat, io_lon)
     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)
     143    CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
     144                            1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
     145                            klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
     146                            io_lat, io_lon)
    99147#endif
    100148!$OMP END MASTER
    … …  
    137185    endif
    138186   
     187#ifndef CPP_NO_IOIPSL
    139188    call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
    140189                      'APPLE',phys_domain_id)
    141 
     190#endif
    142191!$OMP END MASTER
    143192     
    … …  
    197246
    198247!$OMP MASTER   
     248#ifndef CPP_NO_IOIPSL
    199249    if (is_sequential) then
    200250      call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    … …  
    204254                   1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    205255    endif
    206 
     256#endif
    207257!$OMP END MASTER
    208258 
    … …  
    334384    ENDDO
    335385!    print*,'iophy is_sequential nname, nnhori, nnid_day=',trim(nname),nnhori,nnid_day
     386#ifndef CPP_NO_IOIPSL
    336387     call histbeg(nname,pim,plon,plon_bounds, &
    337388                           plat,plat_bounds, &
    338389                           itau0, zjulian, dtime, nnhori, nnid_day)
     390#endif
    339391    else
    340392     npproc=0
    … …  
    373425      ENDIF
    374426     ENDDO
     427#ifndef CPP_NO_IOIPSL
    375428     call histbeg(nname,npstn,npplon,npplon_bounds, &
    376429                            npplat,npplat_bounds, &
    377430                            itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
     431#endif
    378432    endif
    379433!$OMP END MASTER
    … …  
    534588
    535589    IF(.NOT.clef_stations(iff)) THEN 
     590
    536591#ifdef CPP_XIOS
    537         CALL wxios_add_field_to_file(var%name, 2, nid_files(iff), phys_out_filenames(iff), &
     592        CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
    538593        var%description, var%unit, var%flag(iff), typeecrit)
    539594#endif
     595#ifndef CPP_NO_IOIPSL
    540596
    541597       IF ( var%flag(iff)<=lev_files(iff) ) THEN
    … …  
    550606               typeecrit, zstophym,zoutm(iff))               
    551607       ENDIF
     608#endif
    552609    ENDIF
    553610
    … …  
    602659
    603660    IF(.NOT.clef_stations(iff)) THEN
     661
    604662#ifdef CPP_XIOS
    605         CALL wxios_add_field_to_file(var%name, 3, nid_files(iff), phys_out_filenames(iff), &
     663        CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
    606664        var%description, var%unit, var%flag(iff), typeecrit)
    607665#endif
     666#ifndef CPP_NO_IOIPSL
    608667
    609668       IF ( var%flag(iff)<=lev_files(iff) ) THEN
    … …  
    620679               typeecrit, zstophym,zoutm(iff))
    621680       ENDIF
     681#endif
    622682    ENDIF
    623683  END SUBROUTINE histdef3d
    … …  
    849909                        ALLOCATE(index2d(iim*jj_nb))
    850910                        ALLOCATE(fieldok(iim*jj_nb))
    851    
     911#ifndef CPP_NO_IOIPSL
    852912                        CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,iim*jj_nb,index2d)
     913#endif
    853914#ifdef CPP_XIOS
    854915                        IF (iff == iff_beg) THEN
    … …  
    873934                              ENDDO
    874935                       ENDIF
    875    
     936#ifndef CPP_NO_IOIPSL
    876937                       CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
     938#endif
    877939                  ENDIF
    878940                 
    … …  
    9531015                        ALLOCATE(index3d(iim*jj_nb*nlev))
    9541016                        ALLOCATE(fieldok(iim*jj_nb,nlev))
     1017
     1018#ifndef CPP_NO_IOIPSL
    9551019                        CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,iim*jj_nb*nlev,index3d)
     1020#endif
    9561021
    9571022#ifdef CPP_XIOS
    … …  
    9821047                              ENDDO
    9831048                        ENDIF
     1049#ifndef CPP_NO_IOIPSL
    9841050                        CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
     1051#endif
    9851052                  ENDIF
    9861053                  deallocate(index3d)
    … …  
    9931060  END SUBROUTINE histwrite3d_phy
    9941061 
     1062
     1063! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
     1064#ifdef CPP_XIOS
     1065  SUBROUTINE histwrite2d_xios(field_name,field)
     1066  USE dimphy
     1067  USE mod_phys_lmdz_para
     1068  USE wxios
     1069
     1070
     1071  IMPLICIT NONE
     1072  INCLUDE 'dimensions.h'
     1073  INCLUDE 'iniprint.h'
     1074
     1075    CHARACTER(LEN=*), INTENT(IN) :: field_name
     1076    REAL, DIMENSION(:), INTENT(IN) :: field
     1077     
     1078    REAL,DIMENSION(klon_mpi) :: buffer_omp
     1079    INTEGER, allocatable, DIMENSION(:) :: index2d
     1080    REAL :: Field2d(iim,jj_nb)
     1081
     1082    INTEGER :: ip
     1083    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
     1084
     1085    IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
     1086
     1087    !Et sinon on.... écrit
     1088    IF (SIZE(field)/=klon) CALL abort_gcm('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
     1089   
     1090    CALL Gather_omp(field,buffer_omp)   
     1091!$OMP MASTER
     1092    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
     1093   
     1094!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1095!ATTENTION, STATIONS PAS GEREES !
     1096!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1097    !IF(.NOT.clef_stations(iff)) THEN
     1098    IF (.TRUE.) THEN
     1099        ALLOCATE(index2d(iim*jj_nb))
     1100        ALLOCATE(fieldok(iim*jj_nb))
     1101
     1102
     1103        CALL wxios_write_2D(field_name, Field2d)
     1104
     1105    ELSE
     1106        ALLOCATE(fieldok(npstn))
     1107        ALLOCATE(index2d(npstn))
     1108
     1109        IF (is_sequential) THEN
     1110            DO ip=1, npstn
     1111                fieldok(ip)=buffer_omp(nptabij(ip))
     1112            ENDDO
     1113        ELSE
     1114            DO ip=1, npstn
     1115                PRINT*,'histwrite2d_xios is_sequential npstn ip namenptabij',npstn,ip,field_name,nptabij(ip)
     1116                IF(nptabij(ip).GE.klon_mpi_begin.AND. &
     1117                nptabij(ip).LE.klon_mpi_end) THEN
     1118                    fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
     1119                ENDIF
     1120            ENDDO
     1121        ENDIF
     1122
     1123    ENDIF
     1124                 
     1125    deallocate(index2d)
     1126    deallocate(fieldok)
     1127!$OMP END MASTER   
     1128
     1129  IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
     1130  END SUBROUTINE histwrite2d_xios
     1131
     1132
     1133! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
     1134  SUBROUTINE histwrite3d_xios(field_name, field)
     1135  USE dimphy
     1136  USE mod_phys_lmdz_para
     1137  USE wxios
     1138
     1139
     1140  IMPLICIT NONE
     1141  INCLUDE 'dimensions.h'
     1142  INCLUDE 'iniprint.h'
     1143
     1144    CHARACTER(LEN=*), INTENT(IN) :: field_name
     1145    REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
     1146
     1147    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
     1148    REAL :: Field3d(iim,jj_nb,SIZE(field,2))
     1149    INTEGER :: ip, n, nlev
     1150    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     1151    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
     1152
     1153  IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d_xios ',field_name
     1154
     1155    !Et on.... écrit
     1156    IF (SIZE(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
     1157    nlev=SIZE(field,2)
     1158
     1159
     1160    CALL Gather_omp(field,buffer_omp)
     1161!$OMP MASTER
     1162    CALL grid1Dto2D_mpi(buffer_omp,field3d)
     1163
     1164!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1165!ATTENTION, STATIONS PAS GEREES !
     1166!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1167    !IF (.NOT.clef_stations(iff)) THEN
     1168    IF(.TRUE.)THEN
     1169        ALLOCATE(index3d(iim*jj_nb*nlev))
     1170        ALLOCATE(fieldok(iim*jj_nb,nlev))
     1171        CALL wxios_write_3D(field_name, Field3d(:,:,1:klev))
     1172                       
     1173    ELSE
     1174        nlev=size(field,2)
     1175        ALLOCATE(index3d(npstn*nlev))
     1176        ALLOCATE(fieldok(npstn,nlev))
     1177
     1178        IF (is_sequential) THEN
     1179            DO n=1, nlev
     1180                DO ip=1, npstn
     1181                    fieldok(ip,n)=buffer_omp(nptabij(ip),n)
     1182                ENDDO
     1183            ENDDO
     1184        ELSE
     1185            DO n=1, nlev
     1186                DO ip=1, npstn
     1187                    IF(nptabij(ip).GE.klon_mpi_begin.AND. &
     1188                    nptabij(ip).LE.klon_mpi_end) THEN
     1189                        fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
     1190                    ENDIF
     1191                ENDDO
     1192            ENDDO
     1193        ENDIF
     1194    ENDIF
     1195    deallocate(index3d)
     1196    deallocate(fieldok)
     1197!$OMP END MASTER   
     1198
     1199  IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_xios ',field_name
     1200  END SUBROUTINE histwrite3d_xios
     1201#endif
    9951202end module iophy
Note: See TracChangeset for help on using the changeset viewer.