Changeset 483 for codes/icosagcm/trunk


Ignore:
Timestamp:
09/26/16 14:09:01 (8 years ago)
Author:
ymipsl
Message:
  • Add functionnality to input/output field of type U (value on the edges)
  • Management of start/restart files by XIOS

YM

Location:
codes/icosagcm/trunk/src
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/etat0.f90

    r468 r483  
    1414   
    1515  SUBROUTINE init_etat0 
    16   USE etat0_database_mod 
     16  USE etat0_database_mod, init_etat0_database => init_etat0  
     17  USE etat0_start_file_mod, init_etat0_start_file => init_etat0  
    1718  IMPLICIT NONE 
    1819 
    … …  
    2627      CASE ('williamson91.6') 
    2728      CASE ('start_file') 
     29        CALL init_etat0_start_file 
    2830      CASE ('database') 
    2931        CALL init_etat0_database 

  • codes/icosagcm/trunk/src/etat0_database.f90

    r482 r483  
    44CONTAINS 
    55 
    6   SUBROUTINE init_etat0_database 
     6  SUBROUTINE init_etat0 
    77  USE xios_mod 
     8  USE omp_para 
    89  IMPLICIT NONE 
    910   
    10     CALL xios_set_fieldgroup_attr("read_fields",enabled=.TRUE.) 
    11     CALL xios_set_filegroup_attr("read_files",enabled=.TRUE.) 
    12  
    13   END SUBROUTINE init_etat0_database 
     11    IF (is_omp_master) THEN 
     12      CALL xios_set_fieldgroup_attr("read_fields",enabled=.TRUE.) 
     13      CALL xios_set_filegroup_attr("read_files",enabled=.TRUE.) 
     14    ENDIF 
     15  END SUBROUTINE init_etat0 
    1416 
    1517  SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 

  • codes/icosagcm/trunk/src/etat0_start_file.f90

    r476 r483  
    66CONTAINS 
    77   
    8     
     8  SUBROUTINE init_etat0 
     9  USE xios_mod 
     10  USE omp_para 
     11  IMPLICIT NONE 
     12     
     13    IF (is_omp_master) THEN 
     14      IF (using_xios) CALL xios_set_file_attr("start", enabled=.TRUE.) 
     15    ENDIF 
     16     
     17  END SUBROUTINE init_etat0  
     18   
    919  SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 
    1020  USE icosa 

  • codes/icosagcm/trunk/src/icosagcm.f90

    r472 r483  
    2020  USE physics_mod 
    2121  USE tracer_mod 
     22  USE restart_mod 
     23  USE etat0_mod 
    2224  IMPLICIT NONE 
    2325   
    … …  
    3133    CALL compute_domain 
    3234    CALL init_transfert 
    33     CALL init_etat0 
    3435    CALL init_writefield 
    3536    CALL init_trace 
    … …  
    4849    IF (is_mpi_root) CALL write_apbp 
    4950    CALL init_time 
     51    CALL init_restart 
     52    CALL init_etat0 
    5053 
    5154    CALL output_field_init 

  • codes/icosagcm/trunk/src/restart.f90

    r358 r483  
    99 
    1010CONTAINS 
     11   
     12  SUBROUTINE init_restart 
     13  USE xios_mod 
     14  USE icosa 
     15  USE time_mod 
     16  USE omp_para 
     17  IMPLICIT NONE 
     18  CHARACTER(LEN=255) :: start_file_name 
     19  CHARACTER(LEN=255) :: restart_file_name 
     20     
     21    IF (using_xios) THEN 
     22      start_file_name="start" 
     23      CALL getin("start_file_name",start_file_name) 
     24      restart_file_name="restart" 
     25      CALL getin("restart_file_name",restart_file_name) 
     26      IF (is_omp_master) THEN 
     27        CALL xios_set_file_attr("start",name=TRIM(ADJUSTL(start_file_name)),output_freq=(itaumax+1)*xios_timestep) 
     28        CALL xios_set_file_attr("restart",name=TRIM(ADJUSTL(restart_file_name)),output_freq=itaumax*xios_timestep) 
     29        CALL xios_set_fieldgroup_attr("group_restart", freq_op=itaumax*xios_timestep) 
     30        CALL xios_set_axis_attr("lev_read", n_glo=llm) 
     31      ENDIF 
     32    ENDIF 
     33     
     34  END SUBROUTINE init_restart 
     35   
    1136   
    1237  SUBROUTINE write_restart(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   & 
    … …  
    1843  USE netcdf_mod 
    1944  USE mpipara 
     45  USE omp_para 
    2046  USE getin_mod 
    2147  USE spherical_geom_mod 
    2248  USE transfert_mod 
    2349  USE disvert_mod 
    24   
     50  USE xios_mod 
    2551  IMPLICIT NONE  
    2652  INTEGER,INTENT(IN)     :: it 
    … …  
    4773    CALL getin("restart_file_name",restart_file_name) 
    4874 
    49 !$OMP MASTER 
    50  
    51     nfield=0 
    52     IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF 
    53     IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF 
    54     IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF 
    55     IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF 
    56     IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF 
    57     IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF 
    58     IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF 
    59     IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF 
    60     IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF 
    61     IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF 
    62     IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF 
    63     IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF 
    64     IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF 
    65     IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF 
    66     IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF 
    67     IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF 
    68     IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF 
    69     IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF 
    70     IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF 
    71     IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF 
    72      
    73        
    74  
    75     IF (is_mpi_root) THEN 
    76       status = NF90_CREATE(TRIM(ADJUSTL(restart_file_name))//'.nc', NF90_CLOBBER, ncid) 
    77       status = NF90_DEF_DIM(ncid,'cell',ncell_glo,cellId) 
    78       status = NF90_DEF_DIM(ncid,'edge',3*ncell_glo,edgeId) 
    79       status = NF90_DEF_DIM(ncid,'lev',llm,levId) 
    80       status = NF90_DEF_DIM(ncid,'nvert',nvert,vertId) 
    81       status = NF90_DEF_DIM(ncid,'nq',nqtot,nqId) 
    82       status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"iteration",it) 
    83        
    84       status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ cellId /),lonId) 
    85       status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude") 
    86       status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east") 
    87       status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon") 
    88       status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ cellId /),latId) 
    89       status = NF90_PUT_ATT(ncid,latId,"long_name","latitude") 
    90       status = NF90_PUT_ATT(ncid,latId,"units","degrees_north") 
    91       status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat") 
    92       status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ vertId,cellId /),bounds_lonId) 
    93       status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ vertId,cellId /),bounds_latId) 
    94       status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ levId /),levAxisId) 
    95       status = NF90_PUT_ATT(ncid,levAxisId,"axis","Z") 
    96       status = NF90_PUT_ATT(ncid,levAxisId,"units","Pa") 
    97       status = NF90_PUT_ATT(ncid,levAxisId,"positive","down") 
    98        
     75    IF (using_xios) THEN 
     76      IF (PRESENT(field0))  THEN ; CALL  xios_write_field(TRIM(field0(1)%name)//'_restart',field0)  ; ENDIF 
     77      IF (PRESENT(field1))  THEN ; CALL  xios_write_field(TRIM(field1(1)%name)//'_restart',field1)  ; ENDIF 
     78      IF (PRESENT(field2))  THEN ; CALL  xios_write_field(TRIM(field2(1)%name)//'_restart',field2)  ; ENDIF 
     79      IF (PRESENT(field3))  THEN ; CALL  xios_write_field(TRIM(field3(1)%name)//'_restart',field3)  ; ENDIF 
     80      IF (PRESENT(field4))  THEN ; CALL  xios_write_field(TRIM(field4(1)%name)//'_restart',field4)  ; ENDIF 
     81      IF (PRESENT(field5))  THEN ; CALL  xios_write_field(TRIM(field5(1)%name)//'_restart',field5)  ; ENDIF 
     82      IF (PRESENT(field6))  THEN ; CALL  xios_write_field(TRIM(field6(1)%name)//'_restart',field6)  ; ENDIF 
     83      IF (PRESENT(field7))  THEN ; CALL  xios_write_field(TRIM(field7(1)%name)//'_restart',field7)  ; ENDIF 
     84      IF (PRESENT(field8))  THEN ; CALL  xios_write_field(TRIM(field8(1)%name)//'_restart',field8)  ; ENDIF 
     85      IF (PRESENT(field9))  THEN ; CALL  xios_write_field(TRIM(field9(1)%name)//'_restart',field9)  ; ENDIF 
     86      IF (PRESENT(field10))  THEN ; CALL  xios_write_field(TRIM(field10(1)%name)//'_restart',field10)  ; ENDIF 
     87      IF (PRESENT(field11))  THEN ; CALL  xios_write_field(TRIM(field11(1)%name)//'_restart',field11)  ; ENDIF 
     88      IF (PRESENT(field12))  THEN ; CALL  xios_write_field(TRIM(field12(1)%name)//'_restart',field12)  ; ENDIF 
     89      IF (PRESENT(field13))  THEN ; CALL  xios_write_field(TRIM(field13(1)%name)//'_restart',field13)  ; ENDIF 
     90      IF (PRESENT(field14))  THEN ; CALL  xios_write_field(TRIM(field14(1)%name)//'_restart',field14)  ; ENDIF 
     91      IF (PRESENT(field15))  THEN ; CALL  xios_write_field(TRIM(field15(1)%name)//'_restart',field15)  ; ENDIF 
     92      IF (PRESENT(field16))  THEN ; CALL  xios_write_field(TRIM(field16(1)%name)//'_restart',field16)  ; ENDIF 
     93      IF (PRESENT(field17))  THEN ; CALL  xios_write_field(TRIM(field17(1)%name)//'_restart',field17)  ; ENDIF 
     94      IF (PRESENT(field18))  THEN ; CALL  xios_write_field(TRIM(field18(1)%name)//'_restart',field18)  ; ENDIF 
     95      IF (PRESENT(field19))  THEN ; CALL  xios_write_field(TRIM(field19(1)%name)//'_restart',field19)  ; ENDIF 
     96      IF (is_omp_master) CALL xios_send_field("it_restart",it*1.0) 
     97 
     98    ELSE 
     99 
     100    !$OMP MASTER 
     101       
     102      nfield=0 
     103      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF 
     104      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF 
     105      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF 
     106      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF 
     107      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF 
     108      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF 
     109      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF 
     110      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF 
     111      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF 
     112      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF 
     113      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF 
     114      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF 
     115      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF 
     116      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF 
     117      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF 
     118      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF 
     119      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF 
     120      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF 
     121      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF 
     122      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF 
     123       
     124         
     125 
     126      IF (is_mpi_root) THEN 
     127        status = NF90_CREATE(TRIM(ADJUSTL(restart_file_name))//'.nc', NF90_CLOBBER, ncid) 
     128        status = NF90_DEF_DIM(ncid,'cell',ncell_glo,cellId) 
     129        status = NF90_DEF_DIM(ncid,'edge',3*ncell_glo,edgeId) 
     130        status = NF90_DEF_DIM(ncid,'lev',llm,levId) 
     131        status = NF90_DEF_DIM(ncid,'nvert',nvert,vertId) 
     132        status = NF90_DEF_DIM(ncid,'nq',nqtot,nqId) 
     133        status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"iteration",it) 
     134         
     135        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ cellId /),lonId) 
     136        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude") 
     137        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east") 
     138        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon") 
     139        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ cellId /),latId) 
     140        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude") 
     141        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north") 
     142        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat") 
     143        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ vertId,cellId /),bounds_lonId) 
     144        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ vertId,cellId /),bounds_latId) 
     145        status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ levId /),levAxisId) 
     146        status = NF90_PUT_ATT(ncid,levAxisId,"axis","Z") 
     147        status = NF90_PUT_ATT(ncid,levAxisId,"units","Pa") 
     148        status = NF90_PUT_ATT(ncid,levAxisId,"positive","down") 
     149         
     150        DO nf=1,nfield 
     151          field=>field_array(nf)%field 
     152          IF (field(1)%field_type==field_T) THEN 
     153            IF (field(1)%ndim==2) THEN 
     154              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId /),fieldId(nf)) 
     155              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lon lat") 
     156            ELSE IF (field(1)%ndim==3) THEN 
     157              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId /),fieldId(nf)) 
     158              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lev lon lat") 
     159            ELSE IF (field(1)%ndim==4) THEN 
     160              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId,nqId /),fieldId(nf)) 
     161              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","nq lev lon lat") 
     162            ENDIF 
     163          ELSE IF (field(1)%field_type==field_U) THEN 
     164            IF (field(1)%ndim==2) THEN 
     165              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId /),fieldId(nf)) 
     166            ELSE IF (field(1)%ndim==3) THEN 
     167              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId /),fieldId(nf)) 
     168            ELSE IF (field(1)%ndim==4) THEN 
     169              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId, nqId /),fieldId(nf)) 
     170            ENDIF 
     171          ENDIF 
     172        ENDDO 
     173             
     174         
     175        status = NF90_ENDDEF(ncid) 
     176         
     177        ALLOCATE(lon(ncell_glo),lat(ncell_glo),bounds_lon(0:nvert-1,ncell_glo),bounds_lat(0:nvert-1,ncell_glo)) 
     178        DO ind=1,ndomain_glo 
     179          d=>domain_glo(ind) 
     180          DO j=d%jj_begin,d%jj_end 
     181            DO i=d%ii_begin,d%ii_end 
     182               ind_glo=d%assign_cell_glo(i,j) 
     183               CALL xyz2lonlat(d%xyz(:,i,j),lon(ind_glo),lat(ind_glo)) 
     184               lon(ind_glo)=lon(ind_glo)*180/Pi 
     185               lat(ind_glo)=lat(ind_glo)*180/Pi 
     186               DO k=0,5 
     187                   CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ind_glo), bounds_lat(k,ind_glo)) 
     188                   bounds_lat(k,ind_glo)=bounds_lat(k,ind_glo)*180/Pi 
     189                   bounds_lon(k,ind_glo)=bounds_lon(k,ind_glo)*180/Pi 
     190               ENDDO 
     191            ENDDO 
     192          ENDDO 
     193        ENDDO 
     194 
     195        status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell_glo /)) 
     196        status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell_glo /)) 
     197        status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /)) 
     198        status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /)) 
     199        status=NF90_PUT_VAR(ncid,levAxisId,REAL(presnivs,r8),start=(/ 1 /),count=(/ llm /)) 
     200      ENDIF 
     201 
    99202      DO nf=1,nfield 
    100203        field=>field_array(nf)%field 
    101         IF (field(1)%field_type==field_T) THEN 
    102           IF (field(1)%ndim==2) THEN 
    103             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId /),fieldId(nf)) 
    104             status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lon lat") 
    105           ELSE IF (field(1)%ndim==3) THEN 
    106             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId /),fieldId(nf)) 
    107             status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lev lon lat") 
    108           ELSE IF (field(1)%ndim==4) THEN 
    109             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId,nqId /),fieldId(nf)) 
    110             status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","nq lev lon lat") 
    111           ENDIF 
    112         ELSE IF (field(1)%field_type==field_U) THEN 
    113           IF (field(1)%ndim==2) THEN 
    114             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId /),fieldId(nf)) 
    115           ELSE IF (field(1)%ndim==3) THEN 
    116             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId /),fieldId(nf)) 
    117           ELSE IF (field(1)%ndim==4) THEN 
    118             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId, nqId /),fieldId(nf)) 
    119           ENDIF 
    120         ENDIF 
     204        CALL write_restart_field(field,fieldId(nf),ncid) 
    121205      ENDDO 
    122            
    123        
    124       status = NF90_ENDDEF(ncid) 
    125        
    126       ALLOCATE(lon(ncell_glo),lat(ncell_glo),bounds_lon(0:nvert-1,ncell_glo),bounds_lat(0:nvert-1,ncell_glo)) 
    127       DO ind=1,ndomain_glo 
    128         d=>domain_glo(ind) 
    129         DO j=d%jj_begin,d%jj_end 
    130           DO i=d%ii_begin,d%ii_end 
    131              ind_glo=d%assign_cell_glo(i,j) 
    132              CALL xyz2lonlat(d%xyz(:,i,j),lon(ind_glo),lat(ind_glo)) 
    133              lon(ind_glo)=lon(ind_glo)*180/Pi 
    134              lat(ind_glo)=lat(ind_glo)*180/Pi 
    135              DO k=0,5 
    136                  CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ind_glo), bounds_lat(k,ind_glo)) 
    137                  bounds_lat(k,ind_glo)=bounds_lat(k,ind_glo)*180/Pi 
    138                  bounds_lon(k,ind_glo)=bounds_lon(k,ind_glo)*180/Pi 
    139              ENDDO 
    140           ENDDO 
    141         ENDDO 
    142       ENDDO 
    143  
    144       status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell_glo /)) 
    145       status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell_glo /)) 
    146       status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /)) 
    147       status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /)) 
    148       status=NF90_PUT_VAR(ncid,levAxisId,REAL(presnivs,r8),start=(/ 1 /),count=(/ llm /)) 
     206             
     207    !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId /),fieldId(nf)) 
     208    !        ELSE IF (field(1)%ndim==3) THEN 
     209    !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId, levId /),fieldId(nf)) 
     210    !        ENDIF 
     211    !      ENDDO 
     212 
     213 
     214      IF (is_mpi_root) THEN 
     215        status = NF90_CLOSE(ncid)       
     216      ENDIF 
     217     
     218    !$OMP END MASTER 
     219     
    149220    ENDIF 
    150  
    151     DO nf=1,nfield 
    152       field=>field_array(nf)%field 
    153       CALL write_restart_field(field,fieldId(nf),ncid) 
    154     ENDDO 
    155            
    156 !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId /),fieldId(nf)) 
    157 !        ELSE IF (field(1)%ndim==3) THEN 
    158 !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId, levId /),fieldId(nf)) 
    159 !        ENDIF 
    160 !      ENDDO 
    161  
    162  
    163     IF (is_mpi_root) THEN 
    164       status = NF90_CLOSE(ncid)       
    165     ENDIF 
    166 !$OMP END MASTER 
    167221   
    168222  END SUBROUTINE write_restart 
    … …  
    178232  USE spherical_geom_mod 
    179233  USE transfert_mod 
     234  USE xios_mod 
    180235  IMPLICIT NONE 
    181236    TYPE(t_field),POINTER :: field(:) 
    … …  
    274329                      ind_glo=d%assign_cell_glo(i,j) 
    275330                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))   
    276                       global_field2d(ind_glo)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval2d(ij+d%u_pos(k)) 
     331                      global_field2d(e)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval2d(ij+d%u_pos(k)) 
    277332                    ENDIF 
    278333                  ENDDO 
    … …  
    342397  USE spherical_geom_mod 
    343398  USE transfert_mod 
     399  USE xios_mod 
    344400  
    345401  IMPLICIT NONE 
    … …  
    362418  INTEGER    :: status 
    363419  REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:) 
    364     
     420  REAL(rstd) :: it_temp(1) 
    365421    start_file_name="start" 
    366422    CALL getin("start_file_name",start_file_name) 
    367423 
    368 !$OMP MASTER 
    369  
    370     nfield=0 
    371     IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF 
    372     IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF 
    373     IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF 
    374     IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF 
    375     IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF 
    376     IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF 
    377     IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF 
    378     IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF 
    379     IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF 
    380     IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF 
    381     IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF 
    382     IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF 
    383     IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF 
    384     IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF 
    385     IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF 
    386     IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF 
    387     IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF 
    388     IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF 
    389     IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF 
    390     IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF 
    391      
    392        
    393  
    394     IF (is_mpi_root) THEN 
    395       status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid) 
     424 
     425 
     426    IF (using_xios) THEN 
     427      IF (PRESENT(field0))  THEN ; CALL  xios_read_field(TRIM(field0(1)%name)//'_start',field0)  ; ENDIF 
     428      IF (PRESENT(field1))  THEN ; CALL  xios_read_field(TRIM(field1(1)%name)//'_start',field1)  ; ENDIF 
     429      IF (PRESENT(field2))  THEN ; CALL  xios_read_field(TRIM(field2(1)%name)//'_start',field2)  ; ENDIF 
     430      IF (PRESENT(field3))  THEN ; CALL  xios_read_field(TRIM(field3(1)%name)//'_start',field3)  ; ENDIF 
     431      IF (PRESENT(field4))  THEN ; CALL  xios_read_field(TRIM(field4(1)%name)//'_start',field4)  ; ENDIF 
     432      IF (PRESENT(field5))  THEN ; CALL  xios_read_field(TRIM(field5(1)%name)//'_start',field5)  ; ENDIF 
     433      IF (PRESENT(field6))  THEN ; CALL  xios_read_field(TRIM(field6(1)%name)//'_start',field6)  ; ENDIF 
     434      IF (PRESENT(field7))  THEN ; CALL  xios_read_field(TRIM(field7(1)%name)//'_start',field7)  ; ENDIF 
     435      IF (PRESENT(field8))  THEN ; CALL  xios_read_field(TRIM(field8(1)%name)//'_start',field8)  ; ENDIF 
     436      IF (PRESENT(field9))  THEN ; CALL  xios_read_field(TRIM(field9(1)%name)//'_start',field9)  ; ENDIF 
     437      IF (PRESENT(field10))  THEN ; CALL  xios_read_field(TRIM(field10(1)%name)//'_start',field10)  ; ENDIF 
     438      IF (PRESENT(field11))  THEN ; CALL  xios_read_field(TRIM(field11(1)%name)//'_start',field11)  ; ENDIF 
     439      IF (PRESENT(field12))  THEN ; CALL  xios_read_field(TRIM(field12(1)%name)//'_start',field12)  ; ENDIF 
     440      IF (PRESENT(field13))  THEN ; CALL  xios_read_field(TRIM(field13(1)%name)//'_start',field13)  ; ENDIF 
     441      IF (PRESENT(field14))  THEN ; CALL  xios_read_field(TRIM(field14(1)%name)//'_start',field14)  ; ENDIF 
     442      IF (PRESENT(field15))  THEN ; CALL  xios_read_field(TRIM(field15(1)%name)//'_start',field15)  ; ENDIF 
     443      IF (PRESENT(field16))  THEN ; CALL  xios_read_field(TRIM(field16(1)%name)//'_start',field16)  ; ENDIF 
     444      IF (PRESENT(field17))  THEN ; CALL  xios_read_field(TRIM(field17(1)%name)//'_start',field17)  ; ENDIF 
     445      IF (PRESENT(field18))  THEN ; CALL  xios_read_field(TRIM(field18(1)%name)//'_start',field18)  ; ENDIF 
     446      IF (PRESENT(field19))  THEN ; CALL  xios_read_field(TRIM(field19(1)%name)//'_start',field19)  ; ENDIF 
     447! doesn't work for now, to be decomment when xios is ok 
     448!      CALL xios_recv_field("it_start",it_temp) 
     449!      it=it_temp(1) 
     450      it=0 
     451    ELSE 
     452 
     453    !$OMP MASTER 
     454 
     455      nfield=0 
     456      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF 
     457      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF 
     458      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF 
     459      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF 
     460      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF 
     461      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF 
     462      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF 
     463      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF 
     464      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF 
     465      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF 
     466      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF 
     467      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF 
     468      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF 
     469      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF 
     470      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF 
     471      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF 
     472      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF 
     473      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF 
     474      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF 
     475      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF 
     476       
     477         
     478 
     479      IF (is_mpi_root) THEN 
     480        status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid) 
     481      ENDIF 
     482      
     483      DO nf=1,nfield 
     484        field=>field_array(nf)%field 
     485        status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf)) 
     486        status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it) 
     487        CALL read_start_field(field,fieldId(nf),ncid) 
     488      ENDDO 
     489 
     490 
     491      IF (is_mpi_root) THEN 
     492        status = NF90_CLOSE(ncid)       
     493      ENDIF 
     494      
     495     !$OMP END MASTER 
     496     
    396497    ENDIF 
    397     
    398     DO nf=1,nfield 
    399       field=>field_array(nf)%field 
    400       status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf)) 
    401       status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it) 
    402       CALL read_start_field(field,fieldId(nf),ncid) 
    403     ENDDO 
    404  
    405  
    406     IF (is_mpi_root) THEN 
    407       status = NF90_CLOSE(ncid)       
    408     ENDIF 
    409 !$OMP END MASTER 
    410498   
    411499  END SUBROUTINE read_start 

  • codes/icosagcm/trunk/src/write_etat0.f90

    r476 r483  
    1212  USE domain_mod 
    1313  USE omp_para 
     14  USE xios_mod 
    1415  IMPLICIT NONE 
    1516    INTEGER,INTENT(IN)    :: it 

  • codes/icosagcm/trunk/src/xios_mod.F90

    r482 r483  
    1212  INTEGER,SAVE :: ncell_v 
    1313!$OMP THREADPRIVATE(ncell_v) 
    14  
    15   PRIVATE ncell_i,ncell_v 
     14  INTEGER,SAVE :: ncell_e 
     15!$OMP THREADPRIVATE(ncell_e) 
     16 
     17  PRIVATE ncell_i,ncell_v,ncell_e 
    1618 
    1719#ifdef CPP_USING_XIOS 
    … …  
    4446 USE mpi_mod 
    4547 USE time_mod 
    46  USE metric, ONLY : vup,vdown 
     48 USE metric, ONLY : vup,vdown, cell_glo 
    4749 IMPLICIT NONE 
    4850  TYPE(xios_context) :: ctx_hdl 
    … …  
    5153  REAL(rstd) :: lev_valuep1(llm+1) 
    5254  INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size-1), displ 
    53   INTEGER :: ind, i,j,k,l 
     55  INTEGER :: ind, i,j,k,l,ij 
    5456  REAL(rstd),ALLOCATABLE    :: lon(:), lat(:), bounds_lon(:,:), bounds_lat(:,:) 
     57  INTEGER, ALLOCATABLE      :: ind_glo(:) 
    5558  TYPE(t_domain),POINTER :: d 
    5659 
    … …  
    6467   CALL xios_set_axis_attr("lev",n_glo=llm ,value=lev_value) ; 
    6568   CALL xios_set_axis_attr("levp1",n_glo=llm+1 ,value=lev_valuep1) ; 
     69   CALL xios_set_axis_attr("nq",n_glo=nqtot) ; 
    6670    
    6771   ncell=0 
    … …  
    8690   ncell_tot=sum(ncell_glo(:)) 
    8791    
    88    ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell))  
     92   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell), ind_glo(ncell))  
    8993    
    9094   ncell=0 
    … …  
    104108             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi 
    105109           ENDDO 
     110           ind_glo(ncell)=domain(ind)%assign_cell_glo(i,j)-1  
    106111         ENDIF 
    107112       ENDDO 
    … …  
    109114   ENDDO          
    110115 
    111    
    112116   CALL xios_set_domaingroup_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell) 
    113    CALL xios_set_domaingroup_attr("i", data_dim=1, type='unstructured' , nvertex=6) 
     117   CALL xios_set_domaingroup_attr("i", data_dim=1, type='unstructured' , nvertex=6, i_index=ind_glo) 
    114118   CALL xios_set_domaingroup_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat) 
    115119    
    116    DEALLOCATE(lon, lat, bounds_lon, bounds_lat)  
     120   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo)  
    117121     
     122 
     123 
     124   ncell=0 
     125   DO ind=1,ndomain 
     126     d=>domain(ind) 
     127 
     128     DO j=d%jj_begin,d%jj_end 
     129       DO i=d%ii_begin,d%ii_end 
     130         DO k=0,5 
     131            IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j & 
     132                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN 
     133               ncell=ncell+1 
     134            ENDIF 
     135         ENDDO 
     136       ENDDO 
     137     ENDDO 
     138   ENDDO 
     139   ncell_e=ncell 
     140    
     141   CALL MPI_ALLGATHER(ncell_e,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr) 
     142   displ=0 
     143   DO i=1,mpi_rank 
     144     displ=displ+ncell_glo(i-1) 
     145   ENDDO 
     146   ncell_tot=sum(ncell_glo(:)) 
     147    
     148   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:1,ncell), bounds_lat(0:1,ncell),ind_glo(ncell))  
     149 
     150 
     151   ncell=0 
     152   DO ind=1,ndomain 
     153     d=>domain(ind) 
     154     CALL swap_dimensions(ind) 
     155     CALL swap_geometry(ind) 
     156 
     157     DO j=d%jj_begin,d%jj_end 
     158       DO i=d%ii_begin,d%ii_end 
     159         DO k=0,5 
     160           IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j & 
     161                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN 
     162              ncell=ncell+1 
     163              ij=(j-1)*iim+i 
     164 
     165              lon(ncell)=lon_e(ij+u_pos(k+1))*180/Pi 
     166              lat(ncell)=lat_e(ij+u_pos(k+1))*180/Pi 
     167                
     168              CALL xyz2lonlat(d%vertex(:,MOD((k-1)+6,6),i,j),bounds_lon(0,ncell), bounds_lat(0,ncell)) 
     169              CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(1,ncell), bounds_lat(1,ncell)) 
     170              bounds_lon(:,ncell)=bounds_lon(:,ncell)*180/Pi 
     171              bounds_lat(:,ncell)=bounds_lat(:,ncell)*180/Pi 
     172              ind_glo(ncell)=cell_glo(d%assign_cell_glo(i,j))%edge(MOD(k+d%delta(i,j)+6,6))-1  
     173           ENDIF                
     174         ENDDO 
     175       ENDDO 
     176     ENDDO 
     177   ENDDO 
     178   CALL xios_set_domain_attr("u",ni_glo=ncell_tot, ibegin=displ, ni=ncell) 
     179   CALL xios_set_domain_attr("u", data_dim=1, type='unstructured' , nvertex=2, i_index=ind_glo) 
     180   CALL xios_set_domain_attr("u",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat) 
     181 
     182   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo)  
     183 
     184 
    118185   ncell=0 
    119186   DO ind=1,ndomain 
    … …  
    219286   IF (Field(1)%field_type==field_T) THEN 
    220287     IF (field(1)%ndim==2) THEN 
    221         CALL xios_write_field_scalar(name,field,1) 
     288        CALL xios_write_field_scalar(name,field,1,1) 
     289     ELSE IF (field(1)%ndim==3) THEN 
     290        CALL xios_write_field_scalar(name,field,size(field(1)%rval3d,2),1) 
     291     ELSE IF (field(1)%ndim==4) THEN 
     292!        DO iq=1,size(field(1)%rval4d,3) 
     293!          WRITE(str_number,'(i10)') iq 
     294!          CALL xios_write_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq) 
     295          CALL xios_write_field_scalar(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3)) 
     296!        ENDDO 
     297     ELSE 
     298        PRINT *, "xios_write_field : dimension > 4 are not supported for now" 
     299     ENDIF 
     300 
     301   ELSE IF (Field(1)%field_type==field_U) THEN 
     302      IF (field(1)%ndim==2) THEN 
     303        CALL xios_write_field_U(name,field,1,1) 
    222304      ELSE IF (field(1)%ndim==3) THEN 
    223         CALL xios_write_field_scalar(name,field,size(field(1)%rval3d,2)) 
     305        CALL xios_write_field_U(name,field,size(field(1)%rval3d,2),1) 
    224306      ELSE IF (field(1)%ndim==4) THEN 
    225         DO iq=1,size(field(1)%rval4d,3) 
    226           WRITE(str_number,'(i10)') iq 
    227           CALL xios_write_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq) 
    228         ENDDO 
     307        CALL xios_write_field_U(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3)) 
    229308      ELSE 
    230309        PRINT *, "xios_write_field : dimension > 4 are not supported for now" 
    231310      ENDIF 
     311 
    232312    ELSE IF (Field(1)%field_type==field_Z) THEN 
    233313     IF (field(1)%ndim==2) THEN 
    … …  
    262342   IF (Field(1)%field_type==field_T) THEN 
    263343     IF (field(1)%ndim==2) THEN 
    264         CALL xios_read_field_scalar(name,field,1) 
     344        CALL xios_read_field_scalar(name,field,1,1) 
    265345      ELSE IF (field(1)%ndim==3) THEN 
    266         CALL xios_read_field_scalar(name,field,size(field(1)%rval3d,2)) 
     346        CALL xios_read_field_scalar(name,field,size(field(1)%rval3d,2),1) 
    267347      ELSE IF (field(1)%ndim==4) THEN 
    268         DO iq=1,size(field(1)%rval4d,3) 
    269           WRITE(str_number,'(i10)') iq 
    270           CALL xios_read_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq) 
    271         ENDDO 
     348!        DO iq=1,size(field(1)%rval4d,3) 
     349!          WRITE(str_number,'(i10)') iq 
     350!          CALL xios_read_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq) 
     351!        ENDDO 
     352          CALL xios_read_field_scalar(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3)) 
     353      ELSE 
     354        PRINT *, "xios_write_field : dimension > 4 are not supported for now" 
     355      ENDIF 
     356   ELSE IF (Field(1)%field_type==field_U) THEN 
     357     IF (field(1)%ndim==2) THEN 
     358        CALL xios_read_field_u(name,field,1,1) 
     359      ELSE IF (field(1)%ndim==3) THEN 
     360        CALL xios_read_field_u(name,field,size(field(1)%rval3d,2),1) 
     361      ELSE IF (field(1)%ndim==4) THEN 
     362          CALL xios_read_field_u(name,field,size(field(1)%rval4d,2),size(field(1)%rval4d,3)) 
    272363      ELSE 
    273364        PRINT *, "xios_write_field : dimension > 4 are not supported for now" 
    … …  
    294385 
    295386  
    296  SUBROUTINE xios_write_field_scalar(name,field,nlev,iq) 
     387 SUBROUTINE xios_write_field_scalar(name,field,nlev,nq) 
    297388 USE genmod 
    298389 USE mpipara 
    … …  
    308399   TYPE(t_field), POINTER :: field(:) 
    309400   INTEGER,INTENT(IN) :: nlev 
    310    INTEGER,INTENT(IN),OPTIONAL :: iq 
    311     
    312    REAL(rstd) :: field_tmp(ncell_i,nlev) 
     401   INTEGER,INTENT(IN) :: nq 
     402    
     403   REAL(rstd) :: field_tmp(ncell_i,nlev,nq) 
    313404   TYPE(t_domain),POINTER :: d 
    314405   INTEGER :: n,i,j,ij,ind 
    … …  
    325416             n=n+1 
    326417             ij=d%iim*(j-1)+i 
    327              field_tmp(n,1)=field(ind)%rval2d(ij) 
     418             field_tmp(n,1,1)=field(ind)%rval2d(ij) 
    328419           ENDIF 
    329420         ENDDO 
    … …  
    340431             n=n+1 
    341432             ij=d%iim*(j-1)+i 
    342              field_tmp(n,:)=field(ind)%rval3d(ij,:) 
     433             field_tmp(n,:,1)=field(ind)%rval3d(ij,:) 
    343434           ENDIF 
    344435         ENDDO 
    … …  
    355446             n=n+1 
    356447             ij=d%iim*(j-1)+i 
    357              field_tmp(n,:)=field(ind)%rval4d(ij,:,iq) 
     448             field_tmp(n,:,:)=field(ind)%rval4d(ij,:,:) 
    358449           ENDIF 
    359450         ENDDO 
    … …  
    367458 
    368459 
    369  SUBROUTINE xios_read_field_scalar(name,field,nlev,iq) 
     460 SUBROUTINE xios_read_field_scalar(name,field,nlev,nq) 
    370461 USE genmod 
    371462 USE mpipara 
    … …  
    381472   TYPE(t_field), POINTER :: field(:) 
    382473   INTEGER,INTENT(IN) :: nlev 
    383    INTEGER,INTENT(IN),OPTIONAL :: iq 
    384     
    385    REAL(rstd) :: field_tmp(ncell_i,nlev) 
     474   INTEGER,INTENT(IN) :: nq 
     475    
     476   REAL(rstd) :: field_tmp(ncell_i,nlev,nq) 
    386477   TYPE(t_domain),POINTER :: d 
    387478   INTEGER :: n,i,j,ij,ind 
    … …  
    400491             n=n+1 
    401492             ij=d%iim*(j-1)+i 
    402              field(ind)%rval2d(ij)=field_tmp(n,1) 
     493             field(ind)%rval2d(ij)=field_tmp(n,1,1) 
    403494           ENDIF 
    404495         ENDDO 
    … …  
    415506             n=n+1 
    416507             ij=d%iim*(j-1)+i 
    417              field(ind)%rval3d(ij,:)=field_tmp(n,:) 
     508             field(ind)%rval3d(ij,:)=field_tmp(n,:,1) 
    418509           ENDIF 
    419510         ENDDO 
    … …  
    430521             n=n+1 
    431522             ij=d%iim*(j-1)+i 
    432              field(ind)%rval4d(ij,:,iq)=field_tmp(n,:) 
     523             field(ind)%rval4d(ij,:,:)=field_tmp(n,:,:) 
    433524           ENDIF 
    434525         ENDDO 
    … …  
    438529  
    439530 END SUBROUTINE xios_read_field_scalar 
     531 
     532 SUBROUTINE xios_write_field_U(name,field,nlev,nq) 
     533 USE genmod 
     534 USE mpipara 
     535 USE xios 
     536 USE grid_param 
     537 USE domain_mod 
     538 USE dimensions 
     539 USE spherical_geom_mod 
     540 USE geometry 
     541 USE mpi_mod 
     542 IMPLICIT NONE  
     543   CHARACTER(LEN=*),INTENT(IN) :: name 
     544   TYPE(t_field), POINTER :: field(:) 
     545   INTEGER,INTENT(IN) :: nlev 
     546   INTEGER,INTENT(IN) :: nq 
     547    
     548   REAL(rstd) :: field_tmp(ncell_e,nlev,nq) 
     549   TYPE(t_domain),POINTER :: d 
     550   INTEGER :: n,i,j,k,ij,ind 
     551    
     552   IF (field(1)%ndim==2) THEN 
     553     n=0 
     554     DO ind=1,ndomain 
     555       d=>domain(ind) 
     556       CALL swap_dimensions(ind) 
     557       CALL swap_geometry(ind) 
     558 
     559       DO j=d%jj_begin,d%jj_end 
     560         DO i=d%ii_begin,d%ii_end 
     561           DO k=0,5 
     562             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j & 
     563                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN 
     564               n=n+1 
     565               ij=iim*(j-1)+i 
     566               Field_tmp(n,1,1)=d%edge_assign_sign(k,i,j)*field(ind)%rval2d(ij+d%u_pos(k+1)) 
     567             ENDIF 
     568           ENDDO 
     569         ENDDO 
     570       ENDDO 
     571     ENDDO        
     572   
     573   ELSE IF (field(1)%ndim==3) THEN 
     574 
     575     n=0 
     576     DO ind=1,ndomain 
     577       d=>domain(ind) 
     578       CALL swap_dimensions(ind) 
     579       CALL swap_geometry(ind) 
     580 
     581       DO j=d%jj_begin,d%jj_end 
     582         DO i=d%ii_begin,d%ii_end 
     583           DO k=0,5 
     584             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j & 
     585                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN 
     586               n=n+1 
     587               ij=iim*(j-1)+i 
     588               Field_tmp(n,:,1)=d%edge_assign_sign(k,i,j)*field(ind)%rval3d(ij+d%u_pos(k+1),:) 
     589             ENDIF 
     590           ENDDO 
     591         ENDDO 
     592       ENDDO 
     593     ENDDO        
     594 
     595   ELSE IF (field(1)%ndim==4) THEN 
     596 
     597     n=0 
     598     DO ind=1,ndomain 
     599       d=>domain(ind) 
     600       CALL swap_dimensions(ind) 
     601       CALL swap_geometry(ind) 
     602 
     603       DO j=d%jj_begin,d%jj_end 
     604         DO i=d%ii_begin,d%ii_end 
     605           DO k=0,5 
     606             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j & 
     607                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN 
     608               n=n+1 
     609               ij=iim*(j-1)+i 
     610               Field_tmp(n,:,:)=d%edge_assign_sign(k,i,j)*field(ind)%rval4d(ij+d%u_pos(k+1),:,:) 
     611             ENDIF 
     612           ENDDO 
     613         ENDDO 
     614       ENDDO 
     615     ENDDO        
     616 
     617   ENDIF 
     618    
     619   CALL xios_send_field(name,field_tmp) 
     620  
     621 END SUBROUTINE xios_write_field_u  
     622 
     623 
     624 SUBROUTINE xios_read_field_u(name,field,nlev,nq) 
     625 USE genmod 
     626 USE mpipara 
     627 USE xios 
     628 USE grid_param 
     629 USE domain_mod 
     630 USE dimensions 
     631 USE spherical_geom_mod 
     632 USE geometry 
     633 USE mpi_mod 
     634 IMPLICIT NONE  
     635   CHARACTER(LEN=*),INTENT(IN) :: name 
     636   TYPE(t_field), POINTER :: field(:) 
     637   INTEGER,INTENT(IN) :: nlev 
     638   INTEGER,INTENT(IN) :: nq 
     639    
     640   REAL(rstd) :: field_tmp(ncell_e,nlev,nq) 
     641   TYPE(t_domain),POINTER :: d 
     642   INTEGER :: n,i,j,k,ij,ind 
     643 
     644   CALL xios_recv_field(name,field_tmp) 
     645    
     646   IF (field(1)%ndim==2) THEN 
     647     n=0 
     648     DO ind=1,ndomain 
     649       d=>domain(ind) 
     650       CALL swap_dimensions(ind) 
     651       CALL swap_geometry(ind) 
     652 
     653       DO j=d%jj_begin,d%jj_end 
     654         DO i=d%ii_begin,d%ii_end 
     655           DO k=0,5 
     656             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j & 
     657                                                                                 .AND. d%edge_assign_pos(k,i,j)==k) THEN 
     658               n=n+1 
     659               ij=iim*(j-1)+i 
     660               field(ind)%rval2d(ij+d%u_pos(k+1))=Field_tmp(n,1,1)*d%edge_assign_sign(k,i,j) 
     661             ENDIF 
     662           ENDDO 
     663         ENDDO 
     664       ENDDO 
     665     ENDDO        
     666   
     667   ELSE IF (field(1)%ndim==3) THEN 
     668 
     669     n=0 
     670     DO ind=1,ndomain 
     671       d=>domain(ind) 
     672       CALL swap_dimensions(ind) 
     673       CALL swap_geometry(ind) 
     674 
     675       DO j=d%jj_begin,d%jj_end 
     676         DO i=d%ii_begin,d%ii_end 
     677           DO k=0,5 
     678             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j & 
     679                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN 
     680               n=n+1 
     681               ij=iim*(j-1)+i 
     682               field(ind)%rval3d(ij+d%u_pos(k+1),:)=Field_tmp(n,:,1)*d%edge_assign_sign(k,i,j) 
     683             ENDIF 
     684           ENDDO 
     685         ENDDO 
     686       ENDDO 
     687     ENDDO        
     688 
     689   ELSE IF (field(1)%ndim==4) THEN 
     690 
     691     n=0 
     692     DO ind=1,ndomain 
     693       d=>domain(ind) 
     694       CALL swap_dimensions(ind) 
     695       CALL swap_geometry(ind) 
     696 
     697       DO j=d%jj_begin,d%jj_end 
     698         DO i=d%ii_begin,d%ii_end 
     699           DO k=0,5 
     700             IF (d%edge_assign_domain(k,i,j)==domloc_glo_ind(ind) .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j & 
     701                                                                                  .AND. d%edge_assign_pos(k,i,j)==k) THEN 
     702               n=n+1 
     703               ij=iim*(j-1)+i 
     704               field(ind)%rval4d(ij+d%u_pos(k+1),:,:)=Field_tmp(n,:,:)*d%edge_assign_sign(k,i,j) 
     705             ENDIF 
     706           ENDDO 
     707         ENDDO 
     708       ENDDO 
     709     ENDDO        
     710 
     711   ENDIF 
     712    
     713  
     714 END SUBROUTINE xios_read_field_u  
     715 
    440716 
    441717 
    … …  
    673949END INTERFACE  xios_send_field 
    674950 
     951INTEGER,PARAMETER :: xios_timestep=1 
    675952 
    676953CONTAINS   
    … …  
    7241001  END SUBROUTINE xios_set_context 
    7251002   
    726   SUBROUTINE xios_set_fieldgroup_attr(name,enabled) 
     1003  SUBROUTINE xios_set_fieldgroup_attr(name,enabled,freq_op) 
    7271004    CHARACTER(LEN=*) :: name 
    7281005    LOGICAL,OPTIONAL          :: enabled 
     1006    INTEGER,OPTIONAL          :: freq_op 
    7291007  END SUBROUTINE xios_set_fieldgroup_attr 
    7301008 
    … …  
    7331011    LOGICAL,OPTIONAL          :: enabled 
    7341012  END SUBROUTINE xios_set_filegroup_attr 
     1013 
     1014  SUBROUTINE xios_set_file_attr(id,name,enabled, output_freq) 
     1015    CHARACTER(LEN=*) :: id 
     1016    CHARACTER(LEN=*),OPTIONAL :: name 
     1017    LOGICAL,OPTIONAL          :: enabled 
     1018    INTEGER,OPTIONAL          :: output_freq 
     1019  END SUBROUTINE xios_set_file_attr 
    7351020 
    7361021  SUBROUTINE xios_get_axis_attr(name,n_glo,value) 
    … …  
    7401025  END SUBROUTINE xios_get_axis_attr 
    7411026 
     1027  SUBROUTINE xios_set_axis_attr(id,n_glo,value) 
     1028    CHARACTER(LEN=*) :: id 
     1029    INTEGER,OPTIONAL          :: n_glo 
     1030    REAL,OPTIONAL             :: value(:) 
     1031  END SUBROUTINE xios_set_axis_attr 
     1032 
    7421033#endif   
    7431034 
Note: See TracChangeset for help on using the changeset viewer.