- Timestamp:
- 2017-05-08T17:00:32+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7924 r8001 41 41 USE dianam ! build name of file 42 42 USE xios 43 USE iom_def, ONLY : max_rst_fields, rst_fields 43 44 # endif 44 45 USE ioipsl, ONLY : ju2ymds ! for calendar 45 46 USE crs ! Grid coarsening 47 USE lib_fortran 46 48 47 49 IMPLICIT NONE … … 53 55 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 54 56 #endif 55 INTEGER, PRIVATE, PARAMETER :: max_rst_fields = 85 ! maximum number of variables in a restart file56 57 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 57 58 PUBLIC iom_getatt, iom_use, iom_context_finalize … … 63 64 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 64 65 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 65 PRIVATE set_ active_rst_fields66 PRIVATE set_rst_vars, set_rstr_active 66 67 # endif 67 68 … … 138 139 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 139 140 END SELECT 141 140 142 #endif 141 143 ! horizontal grid definition … … 144 146 145 147 IF( TRIM(cdname) == TRIM(cxios_context) .OR. TRIM(cdname) == TRIM(rxios_context)) THEN 146 CALL set_grid( "T", glamt, gphit )147 CALL set_grid( "U", glamu, gphiu )148 CALL set_grid( "V", glamv, gphiv )149 CALL set_grid( "W", glamt, gphit )148 CALL set_grid( "T", glamt, gphit, ln_mskland ) 149 CALL set_grid( "U", glamu, gphiu, ln_mskland ) 150 CALL set_grid( "V", glamv, gphiv, ln_mskland ) 151 CALL set_grid( "W", glamt, gphit, ln_mskland ) 150 152 CALL set_grid_znl( gphit ) 153 CALL set_grid("N",glamt, gphit, .FALSE.) ! not masked values 151 154 ! 152 IF( ln_cfmeta ) THEN ! Add additional grid metadata155 IF( ln_cfmeta .AND. TRIM(cdname) .NE. TRIM(rxios_context)) THEN ! Add additional grid metadata 153 156 CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej)) 154 157 CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej)) … … 165 168 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 166 169 ! 167 CALL set_grid( "T", glamt_crs, gphit_crs )168 CALL set_grid( "U", glamu_crs, gphiu_crs )169 CALL set_grid( "V", glamv_crs, gphiv_crs )170 CALL set_grid( "W", glamt_crs, gphit_crs )170 CALL set_grid( "T", glamt_crs, gphit_crs, ln_mskland ) 171 CALL set_grid( "U", glamu_crs, gphiu_crs, ln_mskland ) 172 CALL set_grid( "V", glamv_crs, gphiv_crs, ln_mskland ) 173 CALL set_grid( "W", glamt_crs, gphit_crs, ln_mskland ) 171 174 CALL set_grid_znl( gphit_crs ) 172 175 ! 173 176 CALL dom_grid_glo ! Return to parent grid domain 174 177 ! 175 IF( ln_cfmeta ) THEN ! Add additional grid metadata178 IF( ln_cfmeta .AND. TRIM(cdname) .NE. TRIM(rxios_context)) THEN ! Add additional grid metadata 176 179 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 177 180 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) … … 230 233 ! automatic definitions of some of the xml attributs 231 234 IF( TRIM(cdname) == TRIM(rxios_context)) THEN 232 CALL set_active_rst_fields 235 !set names of the fields in restart file IF using XIOS to read/write data 236 CALL set_rst_vars() 237 !set which fields are to be read from restart file 238 CALL set_rstr_active() 233 239 ELSE 234 240 CALL set_xmlatt … … 250 256 END SUBROUTINE iom_init 251 257 252 SUBROUTINE set_active_rst_fields 253 !sets enabled = .TRUE. for each field in restart file 254 CHARACTER(len=30),DIMENSION(max_rst_fields) :: rst_fields 255 INTEGER :: i 258 259 SUBROUTINE set_rst_vars() 260 !set names for variables in restart file 256 261 257 262 rst_fields(:)="NO_NAME" … … 343 348 rst_fields(85)="avtb" 344 349 350 END SUBROUTINE set_rst_vars 351 352 353 SUBROUTINE set_rstr_active() 354 !sets enabled = .TRUE. for each field in restart file 355 CHARACTER(len=512) :: rst_file 356 INTEGER :: i 357 TYPE(xios_file) :: file_hdl 358 359 rst_file = TRIM(cn_ocerst_outdir)//TRIM(cn_ocerst_out)//'.nc' 360 !set name of the restart file and enable processing 361 ! if(lwp) WRITE(numout,*) 'Setting restart filename for XIOS to: ',rst_file 362 ! CALL xios_get_handle("restart", file_hdl) 363 ! CALL xios_set_attr(file_hdl , name = trim(rst_file)) 364 ! CALL xios_set_attr(file_hdl , enabled = .TRUE.) 365 !eneble fields in restart file 345 366 DO i = 1, max_rst_fields 346 367 IF( TRIM(rst_fields(i)) /= "NO_NAME") THEN … … 348 369 IF ( xios_is_valid_field( TRIM(rst_fields(i)) ) ) & 349 370 & CALL xios_set_field_attr ( TRIM(rst_fields(i)), enabled = .TRUE. ) 371 IF ( xios_is_valid_field( TRIM(rst_fields(i)) ) ) THEN 372 if(lwp) WRITE(numout,*) TRIM(rst_fields(i)), ' enabled' 373 ENDIF 350 374 ENDIF 351 375 ENDIF 352 376 END DO 353 377 354 END SUBROUTINE set_ active_rst_fields378 END SUBROUTINE set_rstr_active 355 379 356 380 SUBROUTINE iom_swap( cdname ) … … 728 752 #endif 729 753 ENDIF 754 IF(lwp) WRITE(numout,*) 'Value ',pvar 730 755 END SUBROUTINE iom_g0d 731 756 … … 816 841 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use XIOS to read restart 817 842 ! 818 LOGICAL :: lxios843 LOGICAL :: lxios ! local definition for XIOS read 819 844 LOGICAL :: llnoov ! local definition to read overlap 820 845 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute … … 843 868 !--------------------------------------------------------------------- 844 869 ! 870 REAL(wp) :: gma, gmi 845 871 lxios = .FALSE. 846 872 if(PRESENT(lrxios)) lxios = lrxios 847 873 idvar = iom_varid( kiomid, cdvar ) 874 idom = kdom 875 848 876 IF(.NOT.lxios) THEN 849 877 clname = iom_file(kiomid)%name ! esier to read 850 878 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 851 879 ! local definition of the domain ? 852 idom = kdom853 880 ! do we read the overlap 854 881 ! ugly patch SM+JMM+RB to overwrite global definition in some cases … … 1061 1088 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1062 1089 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 1090 if(lwp) write(numout,*) trim(cdvar),'UPDATE' 1063 1091 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1064 1092 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1065 1093 IF( icnt(3) == jpk ) THEN 1066 1094 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1095 if(lwp) write(numout,*) trim(cdvar),'UPDATE' 1067 1096 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1068 1097 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1069 1098 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1099 if(lwp) write(numout,*) trim(cdvar),' NO UPDATE' 1070 1100 ENDIF 1071 1101 ENDIF … … 1080 1110 ENDIF 1081 1111 ! 1082 ELSE ! read using XIOS. Only if key_iomputis defined1112 ELSE ! read using XIOS. Only if KEY_IOMPUT is defined 1083 1113 #if defined key_iomput 1084 ! will not handle scale factor and offset1085 1114 !would be good to be able to check which context is active and swap only if current is not restart 1086 1115 CALL iom_swap( TRIM(rxios_context) ) … … 1088 1117 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1089 1118 CALL xios_recv_field( trim(cdvar), pv_r3d) 1090 IF(idom /= jpdom_unknown ) CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1119 IF(idom /= jpdom_unknown ) then 1120 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1121 ENDIF 1091 1122 ELSEIF( PRESENT(pv_r2d) ) THEN 1092 1123 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1093 1124 CALL xios_recv_field( trim(cdvar), pv_r2d) 1094 IF(idom /= jpdom_unknown ) CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 1125 IF(idom /= jpdom_unknown ) THEN 1126 CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 1127 ENDIF 1095 1128 ELSEIF( PRESENT(pv_r1d) ) THEN 1096 1129 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1097 1130 CALL xios_recv_field( trim(cdvar), pv_r1d) 1098 1131 ENDIF 1099 if(lwp) write(numout,*) 'XIOS RST READ END: ',trim(cdvar)1100 1132 CALL iom_swap( TRIM(cxios_context) ) 1101 1133 #else … … 1126 1158 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1127 1159 ENDIF 1128 1129 1160 END SUBROUTINE iom_get_123d 1130 1161 … … 1530 1561 1531 1562 1532 SUBROUTINE set_grid( cdgrd, plon, plat )1563 SUBROUTINE set_grid( cdgrd, plon, plat, lmask ) 1533 1564 !!---------------------------------------------------------------------- 1534 1565 !! *** ROUTINE set_grid *** … … 1543 1574 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1544 1575 INTEGER :: ni,nj 1576 LOGICAL :: lmask 1545 1577 1546 1578 ni=nlei-nldi+1 ; nj=nlej-nldj+1 … … 1555 1587 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1556 1588 1557 IF ( l n_mskland) THEN1589 IF ( lmask ) THEN 1558 1590 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1559 1591 SELECT CASE ( cdgrd ) … … 1599 1631 ! Offset of coordinate representing bottom-left corner 1600 1632 SELECT CASE ( TRIM(cdgrd) ) 1601 CASE ('T', 'W' )1633 CASE ('T', 'W', 'N') 1602 1634 icnr = -1 ; jcnr = -1 1603 1635 CASE ('U')
Note: See TracChangeset
for help on using the changeset viewer.
