module m_get_mod_fld ! KAL -- This routine reads one of the fields from the model, specified ! KAL -- by name, vertical level and time level ! KAL -- This routine is really only effective for the new restart files. contains !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine get_mod_fld(fld,j,cfld,vlevel,tlevel,nx,ny) #if defined (QMPI) use qmpi #else use qmpi_fake #endif implicit none integer, intent(in) :: nx,ny ! Grid dimension integer, intent(in) :: j ! Ensemble member to read real, dimension(nx,ny), intent(out) :: fld ! output fld character(len=*), intent(in) :: cfld ! name of fld integer, intent(in) :: tlevel ! time level integer, intent(in) :: vlevel ! vertical level integer reclICE real*8, dimension(nx,ny) :: ficem,hicem,hsnwm,ticem,tsrfm logical ex character(len=*),parameter :: icefile='forecastICE.uf' ! KAL -- shortcut -- the analysis is for observation icec -- this little "if" ! means the analysis will only work for ice. Add a check though if ((trim(cfld)/='icec' .and. trim(cfld)/='hice') .or. vlevel/=0 .or. tlevel/=1)then if (master) print *,'get_mod_fld only works for icec for now' call stop_mpi() end if !################################################################### !####################### READ ICE MODEL ######################### !################################################################### #if defined (ICE) #warning "COMPILING WITH ICE" inquire(exist=ex,file=icefile) if (.not.ex) then if (master) then print *,icefile//' does not exist!' print *,'(get_mod_fld)' end if call stop_mpi() end if inquire(iolength=reclICE)ficem,hicem,hsnwm,ticem,tsrfm !,iceU,iceV open(10,file=icefile,form='unformatted',access='direct',recl=reclICE,action='read') read(10,rec=j)ficem,hicem,hsnwm,ticem,tsrfm !,iceU,iceV if (trim(cfld)=='icec') fld = ficem if (trim(cfld)=='hice') fld = hicem close(10) #else #warning "COMPILING WITHOUT ICE" #endif return end subroutine get_mod_fld ! KAL - This is for the new file type subroutine get_mod_fld_new(memfile,fld,iens,cfld,vlevel,tlevel,nx,ny) use mod_raw_io #if defined (QMPI) use qmpi, only : qmpi_proc_num, master #else use qmpi_fake #endif implicit none integer, intent(in) :: nx,ny ! Grid dimension integer, intent(in) :: iens ! Ensemble member to read real, dimension(nx,ny), intent(out) :: fld ! output fld character(len=*), intent(in) :: memfile! base name of input files character(len=*), intent(in) :: cfld ! name of fld integer, intent(in) :: tlevel ! time level integer, intent(in) :: vlevel ! vertical level real*8, dimension(nx,ny) :: readfldr8 real*4, dimension(nx,ny) :: readfldr4 real*4:: amin, amax,spval real :: bmin, bmax integer :: indx ! Dette fordi is-variablane forelobig er paa gammalt format. if (trim(cfld) /= 'icec' .and. trim(cfld) /= 'hice') then ! KAL - 1) f kva index som skal lesast finn vi fraa .b fil (header) call rst_index_from_header(trim(memfile)//'.b', & ! filnavn utan extension cfld , & ! felt som skal lesast fex saln,temp vlevel, & ! vertikalnivaa tlevel, & ! time level - kan vere 1 eller 2 - vi bruker 1 foreloepig indx, & ! indexen som maa lesas fra data fila bmin,bmax, & ! min/max - kan sjekkast mot det som er i datafila .true. ) if (indx < 0) then if (master) then print *, 'ERROR: get_mod_fld_new(): ', trim(memfile), '.b: "',& trim(cfld), '" not found' end if stop end if ! KAL -- les datafelt vi fann fraa header fila (indx) spval=0. call READRAW(readfldr4 ,& ! Midlertidig felt som skal lesast amin, amax ,& ! max/min fraa data (.a) fila nx,ny ,& ! dimensjonar .false.,spval ,& ! dette brukast for sette "no value" verdiar trim(memfile)//'.a',& ! fil som skal lesast fraa indx) ! index funne over ! Sjekk p at vi har lest rett - samanlign max/min fr filene if (abs(amin-bmin).gt.abs(bmin)*1.e-4 .or. & abs(bmax-amax).gt.abs(bmax)*1.e-4 ) then print *,'Inconsistency between .a and .b files' print *,'.a : ',amin,amax print *,'.b : ',bmin,bmax print *,cfld,vlevel,tlevel print *,indx print *,'node ',qmpi_proc_num call exit(1) end if fld=readfldr4 else ! fld = fice, hice ! Gammal rutine ja call get_mod_fld(readfldr8,iens,cfld,0,1,nx,ny) fld=readfldr8 end if end subroutine end module m_get_mod_fld