Skip to content

Commit

Permalink
Make the handling of unformatted units consistent for all unformatted…
Browse files Browse the repository at this point in the history
… files. (#12)

This PR complements previous various commits to handle unformatted binary I/O.

Setting environment variable `setenv GFORTRAN_CONVERT_UNIT 'big_endian:101-200'` is still required for mpas/mpasjedi excutables built within mpas_bundle for reasons described in commit 7f75b3a.

The issue noted in JCSDA-internal/mpas-bundle#86 is that 'native' should not have been set in GFORTRAN_CONVERT_UNIT. When the code is compiled with big_endian, setting runtime environment native (little_endian on cheyenne) overwrites the compilation setting. The ungrib files are read by mpas_init_atmosphere through unit number 10-100 in the original code.

This PR is a follow-on to MPAS-Dev#743, ensuring that `mpas_new_unit` and `mpas_release_unit` are used to manage file units instead of using fixed values.
  • Loading branch information
jamiebresch authored Feb 16, 2021
1 parent 651728e commit 77d24de
Show file tree
Hide file tree
Showing 3 changed files with 86 additions and 75 deletions.
74 changes: 39 additions & 35 deletions src/core_atmosphere/physics/physics_wrf/module_mp_thompson.F
Original file line number Diff line number Diff line change
Expand Up @@ -411,6 +411,7 @@ MODULE module_mp_thompson

!=================================================================================================================
subroutine thompson_init(l_mp_tables)
use mpas_io_units, only : mpas_new_unit, mpas_release_unit
implicit none
!=================================================================================================================

Expand All @@ -421,6 +422,7 @@ subroutine thompson_init(l_mp_tables)
integer:: i,j,k,l,m,n
integer:: istat
logical:: micro_init
integer:: mp_unit

!..Allocate space for lookup tables (J. Michalakes 2009Jun08).
micro_init = .FALSE.
Expand Down Expand Up @@ -833,18 +835,19 @@ subroutine thompson_init(l_mp_tables)
call table_dropEvap

!..Rain collecting graupel & graupel collecting rain.
open(unit=11,file='MP_THOMPSON_QRacrQG_DATA.DBL',form='UNFORMATTED',status='OLD',action='READ', &
call mpas_new_unit(mp_unit, unformatted = .true.)
open(unit=mp_unit,file='MP_THOMPSON_QRacrQG_DATA.DBL',form='UNFORMATTED',status='OLD',action='READ', &
iostat = istat)
if(istat /= open_OK) &
call physics_error_fatal('subroutine thompson_init: ' // &
'failure opening MP_THOMPSON_QRacrQG.DBL')
read(11) tcg_racg
read(11) tmr_racg
read(11) tcr_gacr
read(11) tmg_gacr
read(11) tnr_racg
read(11) tnr_gacr
close(unit=11)
read(mp_unit) tcg_racg
read(mp_unit) tmr_racg
read(mp_unit) tcr_gacr
read(mp_unit) tmg_gacr
read(mp_unit) tnr_racg
read(mp_unit) tnr_gacr
close(unit=mp_unit)
! write(0,*) '--- end read MP_THOMPSON_QRacrQG.DBL'
! write(0,*) 'max tcg_racg =',maxval(tcg_racg)
! write(0,*) 'min tcg_racg =',minval(tcg_racg)
Expand All @@ -860,24 +863,24 @@ subroutine thompson_init(l_mp_tables)
! write(0,*) 'min tnr_gacr =',minval(tnr_gacr)

!..Rain collecting snow & snow collecting rain.
open(unit=11,file='MP_THOMPSON_QRacrQS_DATA.DBL',form='UNFORMATTED',status='OLD',action='READ', &
open(unit=mp_unit,file='MP_THOMPSON_QRacrQS_DATA.DBL',form='UNFORMATTED',status='OLD',action='READ', &
iostat=istat)
if(istat /= open_OK) &
call physics_error_fatal('subroutine thompson_init: ' // &
'failure opening MP_THOMPSON_QRacrQS.DBL')
read(11) tcs_racs1
read(11) tmr_racs1
read(11) tcs_racs2
read(11) tmr_racs2
read(11) tcr_sacr1
read(11) tms_sacr1
read(11) tcr_sacr2
read(11) tms_sacr2
read(11) tnr_racs1
read(11) tnr_racs2
read(11) tnr_sacr1
read(11) tnr_sacr2
close(unit=11)
read(mp_unit) tcs_racs1
read(mp_unit) tmr_racs1
read(mp_unit) tcs_racs2
read(mp_unit) tmr_racs2
read(mp_unit) tcr_sacr1
read(mp_unit) tms_sacr1
read(mp_unit) tcr_sacr2
read(mp_unit) tms_sacr2
read(mp_unit) tnr_racs1
read(mp_unit) tnr_racs2
read(mp_unit) tnr_sacr1
read(mp_unit) tnr_sacr2
close(unit=mp_unit)
! write(0,*) '--- end read MP_THOMPSON_QRacrQS.DBL'
! write(0,*) 'max tcs_racs1 =',maxval(tcs_racs1)
! write(0,*) 'min tcs_racs1 =',minval(tcs_racs1)
Expand Down Expand Up @@ -905,18 +908,18 @@ subroutine thompson_init(l_mp_tables)
! write(0,*) 'min tnr_sacr2 =',minval(tnr_sacr2)

!..Cloud water and rain freezing (Bigg, 1953).
open(unit=11,file='MP_THOMPSON_freezeH2O_DATA.DBL',form='UNFORMATTED',status='OLD',action='READ', &
open(unit=mp_unit,file='MP_THOMPSON_freezeH2O_DATA.DBL',form='UNFORMATTED',status='OLD',action='READ', &
iostat=istat)
if(istat /= open_OK) &
call physics_error_fatal('subroutine thompson_init: ' // &
'failure opening MP_THOMPSON_freezeH2O.DBL')
read(11) tpi_qrfz
read(11) tni_qrfz
read(11) tpg_qrfz
read(11) tnr_qrfz
read(11) tpi_qcfz
read(11) tni_qcfz
close(unit=11)
read(mp_unit) tpi_qrfz
read(mp_unit) tni_qrfz
read(mp_unit) tpg_qrfz
read(mp_unit) tnr_qrfz
read(mp_unit) tpi_qcfz
read(mp_unit) tni_qcfz
close(unit=mp_unit)
! write(0,*) '--- end read MP_THOMPSON_freezeH2O.DBL:'
! write(0,*) 'max tpi_qrfz =',maxval(tpi_qrfz)
! write(0,*) 'min tpi_qrfz =',minval(tpi_qrfz)
Expand All @@ -932,15 +935,16 @@ subroutine thompson_init(l_mp_tables)
! write(0,*) 'min tni_qcfz =',minval(tni_qcfz)

!..Conversion of some ice mass into snow category.
open(unit=11,file='MP_THOMPSON_QIautQS_DATA.DBL',form='UNFORMATTED',status='OLD',action='READ', &
open(unit=mp_unit,file='MP_THOMPSON_QIautQS_DATA.DBL',form='UNFORMATTED',status='OLD',action='READ', &
iostat=istat)
if(istat /= open_OK) &
call physics_error_fatal('subroutine thompson_init: ' // &
'failure opening MP_THOMPSON_QIautQS.DBL')
read(11) tpi_ide
read(11) tps_iaus
read(11) tni_iaus
close(unit=11)
read(mp_unit) tpi_ide
read(mp_unit) tps_iaus
read(mp_unit) tni_iaus
close(unit=mp_unit)
call mpas_release_unit(mp_unit)
! write(0,*) '--- end read MP_THOMPSON_QIautQS.DBL '
! write(0,*) 'max tps_iaus =',maxval(tps_iaus)
! write(0,*) 'min tps_iaus =',minval(tps_iaus)
Expand Down
76 changes: 41 additions & 35 deletions src/core_atmosphere/utils/atmphys_build_tables_thompson.F
Original file line number Diff line number Diff line change
Expand Up @@ -25,85 +25,91 @@ module atmphys_build_tables_thompson
subroutine build_tables_thompson
!=================================================================================================================

use mpas_io_units, only : mpas_new_unit, mpas_release_unit

!local variables:
logical, parameter:: l_mp_tables = .false.
integer:: istatus
integer:: mp_unit

!-----------------------------------------------------------------------------------------------------------------

!--- partial initialization before building the look-up tables:
call thompson_init(l_mp_tables)

call mpas_new_unit(mp_unit, unformatted = .true.)

!--- building look-up table for rain collecting graupel:
write(0,*)
write(0,*) '--- building MP_THOMPSON_QRacrQG_DATA.DBL'
open(unit=11,file='MP_THOMPSON_QRacrQG_DATA.DBL',form='unformatted',status='new',iostat=istatus)
open(unit=mp_unit,file='MP_THOMPSON_QRacrQG_DATA.DBL',form='unformatted',status='new',iostat=istatus)
if (istatus /= 0) then
call print_parallel_mesg('MP_THOMPSON_QRacrQG_DATA.DBL')
return
end if
call qr_acr_qg
write(11) tcg_racg
write(11) tmr_racg
write(11) tcr_gacr
write(11) tmg_gacr
write(11) tnr_racg
write(11) tnr_gacr
close(unit=11)
write(mp_unit) tcg_racg
write(mp_unit) tmr_racg
write(mp_unit) tcr_gacr
write(mp_unit) tmg_gacr
write(mp_unit) tnr_racg
write(mp_unit) tnr_gacr
close(unit=mp_unit)

!--- building look-up table for rain collecting snow:
write(0,*)
write(0,*) '--- building MP_THOMPSON_QRacrQS_DATA.DBL'
open(unit=11,file='MP_THOMPSON_QRacrQS_DATA.DBL',form='unformatted',status='new',iostat=istatus)
open(unit=mp_unit,file='MP_THOMPSON_QRacrQS_DATA.DBL',form='unformatted',status='new',iostat=istatus)
if (istatus /= 0) then
call print_parallel_mesg('MP_THOMPSON_QRacrQS_DATA.DBL')
return
end if
call qr_acr_qs
write(11)tcs_racs1
write(11)tmr_racs1
write(11)tcs_racs2
write(11)tmr_racs2
write(11)tcr_sacr1
write(11)tms_sacr1
write(11)tcr_sacr2
write(11)tms_sacr2
write(11)tnr_racs1
write(11)tnr_racs2
write(11)tnr_sacr1
write(11)tnr_sacr2
close(unit=11)
write(mp_unit)tcs_racs1
write(mp_unit)tmr_racs1
write(mp_unit)tcs_racs2
write(mp_unit)tmr_racs2
write(mp_unit)tcr_sacr1
write(mp_unit)tms_sacr1
write(mp_unit)tcr_sacr2
write(mp_unit)tms_sacr2
write(mp_unit)tnr_racs1
write(mp_unit)tnr_racs2
write(mp_unit)tnr_sacr1
write(mp_unit)tnr_sacr2
close(unit=mp_unit)

!--- building look-up table for freezing of cloud droplets:
write(0,*)
write(0,*) '--- building MP_THOMPSON_freezeH2O_DATA.DBL'
open(unit=11,file='MP_THOMPSON_freezeH2O_DATA.DBL',form='unformatted',status='new',iostat=istatus)
open(unit=mp_unit,file='MP_THOMPSON_freezeH2O_DATA.DBL',form='unformatted',status='new',iostat=istatus)
if (istatus /= 0) then
call print_parallel_mesg('MP_THOMPSON_freezeH2O_DATA.DBL')
return
end if
call freezeH2O
write(11) tpi_qrfz
write(11) tni_qrfz
write(11) tpg_qrfz
write(11) tnr_qrfz
write(11) tpi_qcfz
write(11) tni_qcfz
close(unit=11)
write(mp_unit) tpi_qrfz
write(mp_unit) tni_qrfz
write(mp_unit) tpg_qrfz
write(mp_unit) tnr_qrfz
write(mp_unit) tpi_qcfz
write(mp_unit) tni_qcfz
close(unit=mp_unit)

!--- building look-up table for autoconversion of cloud ice to snow:
write(0,*)
write(0,*) '--- building MP_THOMPSON_QIautQS_DATA.DBL'
open(unit=11,file='MP_THOMPSON_QIautQS_DATA.DBL',form='unformatted',status='new',iostat=istatus)
open(unit=mp_unit,file='MP_THOMPSON_QIautQS_DATA.DBL',form='unformatted',status='new',iostat=istatus)
if (istatus /= 0) then
call print_parallel_mesg('MP_THOMPSON_QIautQS_DATA.DBL')
return
end if
call qi_aut_qs
write(11) tpi_ide
write(11) tps_iaus
write(11) tni_iaus
close(unit=11)
write(mp_unit) tpi_ide
write(mp_unit) tps_iaus
write(mp_unit) tni_iaus
close(unit=mp_unit)
call mpas_release_unit(mp_unit)

write(0,*)
write(0,*) 'Finished building all tables.'
Expand Down
11 changes: 6 additions & 5 deletions src/core_init_atmosphere/mpas_init_atm_read_met.F
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ subroutine read_met_init(fg_source, source_is_constant, datestr, istatus)

use mpas_derived_types, only : MPAS_LOG_ERR
use mpas_log, only : mpas_log_write
use mpas_io_units, only : mpas_new_unit

implicit none

Expand All @@ -75,11 +76,8 @@ subroutine read_met_init(fg_source, source_is_constant, datestr, istatus)
end if

! 2) OPEN FILE
do input_unit=10,100
inquire(unit=input_unit, opened=is_used)
if (.not. is_used) exit
end do
if (input_unit > 100) call mpas_log_write('In read_met_init(), couldn''t find an available Fortran unit.', messageType=MPAS_LOG_ERR)
call mpas_new_unit(input_unit, unformatted = .true.)
if (input_unit < 0) call mpas_log_write('In read_met_init(), couldn''t find an available Fortran unit.', messageType=MPAS_LOG_ERR)
open(unit=input_unit, file=trim(filename), status='old', form='unformatted', iostat=io_status)

if (io_status > 0) istatus = 1
Expand Down Expand Up @@ -418,9 +416,12 @@ end subroutine read_next_met_field
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine read_met_close()

use mpas_io_units, only : mpas_release_unit

implicit none

close(unit=input_unit)
call mpas_release_unit(input_unit)
filename = 'UNINITIALIZED_FILENAME'

end subroutine read_met_close
Expand Down

0 comments on commit 77d24de

Please sign in to comment.