480
481
483
484
485
486 integer, intent(in) :: ng, tile, model
487 integer, intent(in) :: LBi, UBi, LBj, UBj
488
489
490
491# ifdef SOLVE3D
492 logical :: got_generic
493 logical :: got_specific(NT(ng))
494
495# endif
496 integer :: gtype, i, ic, ifield, itrc
497 integer :: nvatt, nvdim, status, vindex
498 integer :: Vsize(4)
499# ifdef CHECKSUM
500 integer(i8b) :: Fhash
501# endif
502
503 real(dp) :: Fscl
504 real(r8) :: Fmax, Fmin
505
506 character (len=40 ) :: tunits
507 character (len=256) :: ncname
508
509 character (len=*), parameter :: MyFile = &
510 & __FILE__//", get_nudgcoef_nf90"
511
512 TYPE (IO_Desc_t), pointer :: ioDesc
513
514 sourcefile=myfile
515
516
517
518
519
520
521 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
522 ncname=nud(ng)%name
523
524
525
526 IF (nud(ng)%pioFile%fh.eq.-1) THEN
528 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
529 WRITE (stdout,10) trim(ncname)
530 RETURN
531 END IF
532 END IF
533
534
535
537 & piofile = nud(ng)%pioFile)
538 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
539
540
541
543 & piofile = nud(ng)%pioFile)
544 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
545
546
547
548
549
550
551
552 IF (lnudgem2clm(ng)) THEN
553 IF (.not.find_string(var_name,n_var,vname(1,idm2nc), &
554 & vindex)) THEN
555 IF (master) WRITE (stdout,20) trim(vname(1,idm2nc)), &
556 & trim(ncname)
557 exit_flag=2
558 RETURN
559 END IF
560 nud(ng)%pioVar(idm2nc)%vd=
var_desc(vindex)
561 END IF
562
563# ifdef SOLVE3D
564
565
566
567 IF (lnudgem3clm(ng)) THEN
568 IF (.not.find_string(var_name,n_var,vname(1,idm3nc), &
569 & vindex)) THEN
570 IF (master) WRITE (stdout,20) trim(vname(1,idm3nc)), &
571 & trim(ncname)
572 exit_flag=2
573 RETURN
574 END IF
575 nud(ng)%pioVar(idm3nc)%vd=
var_desc(vindex)
576 END IF
577
578
579
580 IF (any(lnudgetclm(:,ng))) THEN
581 IF (find_string(var_name,n_var,vname(1,idgtnc),vindex)) THEN
582 got_generic=.true.
583 nud(ng)%pioVar(idgtnc)%vd=
var_desc(vindex)
584 ELSE
585 got_generic=.false.
586 END IF
587
588 DO itrc=1,nt(ng)
589 IF (lnudgetclm(itrc,ng)) THEN
590 ifield=idtnud(itrc)
591 IF (find_string(var_name,n_var,vname(1,ifield),vindex)) THEN
592 got_specific(itrc)=.true.
593 nud(ng)%pioVar(ifield)%vd=
var_desc(vindex)
594 ELSE
595 got_specific(itrc)=.false.
596 END IF
597
598 IF (.not.(got_generic.or.got_specific(itrc))) THEN
599 IF (master) WRITE (stdout,30) trim(vname(1,idgtnc)), &
600 & trim(vname(1,ifield)), &
601 & trim(ncname)
602 exit_flag=2
603 RETURN
604 END IF
605 END IF
606 END DO
607 END IF
608# endif
609
610
611
612
613
614
615
616
617 DO i=1,4
618 vsize(i)=0
619 END DO
620
621
622
623
624 IF (master) WRITE (stdout,'(1x)')
625
626 IF (lnudgem2clm(ng)) THEN
627 ifield=idm2nc
628 fscl=1.0_dp/day2sec
629 nud(ng)%pioVar(ifield)%gtype=r2dvar
630
632 & piofile = nud(ng)%pioFile, &
633 & myvarname = trim(vname(1,ifield)), &
634 & piovar = nud(ng)%pioVar(ifield)%vd, &
635 & nvardim = nvdim, &
636 & nvaratt = nvatt)
637 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
638
639 DO i=1,nvatt
640 IF (trim(var_aname(i)).eq.'units') THEN
641 tunits=trim(var_achar(i))
642 IF (tunits(1:3).eq.'day') THEN
643 fscl=1.0_dp/day2sec
644 ELSE IF (tunits(1:6).eq.'second') THEN
645 fscl=1.0_dp
646 END IF
647 END IF
648 END DO
649
650 IF (kind(clima(ng)%M2nudgcof).eq.8) THEN
651 nud(ng)%pioVar(ifield)%dkind=pio_double
653 ELSE
654 nud(ng)%pioVar(ifield)%dkind=pio_real
656 END IF
657
658 status=nf_fread2d(ng, model, ncname, nud(ng)%pioFile, &
659 & vname(1,ifield), nud(ng)%pioVar(ifield), &
660 & 0, iodesc, vsize, &
661 & lbi, ubi, lbj, ubj, &
662 & fscl, fmin, fmax, &
663# ifdef MASKING
664 & grid(ng) % rmask, &
665# endif
666# ifdef CHECKSUM
667 & clima(ng) % M2nudgcof, &
668 & checksum = fhash)
669# else
670 & clima(ng) % M2nudgcof)
671# endif
672 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
673 exit_flag=2
674 ioerror=status
675 RETURN
676 ELSE
677 IF (master) THEN
678 WRITE (stdout,40) trim(vname(2,ifield))//': '// &
679 & trim(vname(1,ifield)), &
680 & ng, trim(ncname), fmin, fmax
681# ifdef CHECKSUM
682 WRITE (stdout,50) fhash
683# endif
684 END IF
685 END IF
686
687 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
688 CALL exchange_r2d_tile (ng, tile, &
689 & lbi, ubi, lbj, ubj, &
690 & clima(ng) % M2nudgcof)
691 END IF
692# ifdef DISTRIBUTE
693 CALL mp_exchange2d (ng, tile, model, 1, &
694 & lbi, ubi, lbj, ubj, &
695 & nghostpoints, &
696 & ewperiodic(ng), nsperiodic(ng), &
697 & clima(ng) % M2nudgcof)
698# endif
699 END IF
700
701# ifdef SOLVE3D
702
703
704
705
706 IF (lnudgem3clm(ng)) THEN
707 ifield=idm3nc
708 fscl=1.0_dp/day2sec
709 nud(ng)%pioVar(ifield)%gtype=r3dvar
710
712 & piofile = nud(ng)%pioFile, &
713 & myvarname = trim(vname(1,ifield)), &
714 & piovar = nud(ng)%pioVar(ifield)%vd, &
715 & nvardim = nvdim, &
716 & nvaratt = nvatt)
717 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
718
719 DO i=1,nvatt
720 IF (trim(var_aname(i)).eq.'units') THEN
721 tunits=trim(var_achar(i))
722 IF (tunits(1:3).eq.'day') THEN
723 fscl=1.0_dp/day2sec
724 ELSE IF (tunits(1:6).eq.'second') THEN
725 fscl=1.0_dp
726 END IF
727 END IF
728 END DO
729
730 IF (kind(clima(ng)%M3nudgcof).eq.8) THEN
731 nud(ng)%pioVar(ifield)%dkind=pio_double
733 ELSE
734 nud(ng)%pioVar(ifield)%dkind=pio_real
736 END IF
737
738 status=nf_fread3d(ng, model, ncname, nud(ng)%pioFile, &
739 & vname(1,ifield), nud(ng)%pioVar(ifield), &
740 & 0, iodesc, vsize, &
741 & lbi, ubi, lbj, ubj, 1, n(ng), &
742 & fscl, fmin, fmax, &
743# ifdef MASKING
744 & grid(ng) % rmask, &
745# endif
746# ifdef CHECKSUM
747 & clima(ng) % M3nudgcof, &
748 & checksum = fhash)
749# else
750 & clima(ng) % M3nudgcof)
751# endif
752 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
753 exit_flag=2
754 ioerror=status
755 RETURN
756 ELSE
757 IF (master) THEN
758 WRITE (stdout,40) trim(vname(2,ifield))//': '// &
759 & trim(vname(1,ifield)), &
760 & ng, trim(ncname), fmin, fmax
761# ifdef CHECKSUM
762 WRITE (stdout,50) fhash
763# endif
764 END IF
765 END IF
766
767 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
768 CALL exchange_r3d_tile (ng, tile, &
769 & lbi, ubi, lbj, ubj, 1, n(ng), &
770 & clima(ng) % M3nudgcof)
771 END IF
772# ifdef DISTRIBUTE
773 CALL mp_exchange3d (ng, tile, model, 1, &
774 & lbi, ubi, lbj, ubj, 1, n(ng), &
775 & nghostpoints, &
776 & ewperiodic(ng), nsperiodic(ng), &
777 & clima(ng) % M3nudgcof)
778# endif
779 END IF
780
781
782
783
784
785
786
787 ic=0
788 DO itrc=1,nt(ng)
789 IF (lnudgetclm(itrc,ng)) THEN
790 ic=ic+1
791 IF (got_specific(itrc)) THEN
792 ifield=idtnud(itrc)
793 fscl=1.0_dp/day2sec
794 ELSE IF (got_generic) THEN
795 ifield=idgtnc
796 fscl=1.0_dp/day2sec
797 END IF
798 nud(ng)%pioVar(ifield)%gtype=r3dvar
799
801 & piofile = nud(ng)%pioFile, &
802 & myvarname = trim(vname(1,ifield)), &
803 & piovar = nud(ng)%pioVar(ifield)%vd, &
804 & nvardim = nvdim, &
805 & nvaratt = nvatt)
806 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
807
808 DO i=1,nvatt
809 IF (trim(var_aname(i)).eq.'units') THEN
810 tunits=trim(var_achar(i))
811 IF (tunits(1:3).eq.'day') THEN
812 fscl=1.0_dp/day2sec
813 ELSE IF (tunits(1:6).eq.'second') THEN
814 fscl=1.0_dp
815 END IF
816 END IF
817 END DO
818
819 IF (kind(clima(ng)%Tnudgcof).eq.8) THEN
820 nud(ng)%pioVar(ifield)%dkind=pio_double
822 ELSE
823 nud(ng)%pioVar(ifield)%dkind=pio_real
825 END IF
826
827 status=nf_fread3d(ng, model, ncname, nud(ng)%pioFile, &
828 & vname(1,ifield), nud(ng)%pioVar(ifield), &
829 & 0, iodesc, vsize, &
830 & lbi, ubi, lbj, ubj, 1, n(ng), &
831 & fscl, fmin, fmax, &
832# ifdef MASKING
833 & grid(ng) % rmask, &
834# endif
835# ifdef CHECKSUM
836 & clima(ng) % Tnudgcof(:,:,:,ic), &
837 & checksum = fhash)
838# else
839 & clima(ng) % Tnudgcof(:,:,:,ic))
840# endif
841 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
842 exit_flag=2
843 ioerror=status
844 RETURN
845 ELSE
846 IF (master) THEN
847 WRITE (stdout,40) trim(vname(2,ifield))//': '// &
848 & trim(vname(1,ifield)), &
849 & ng, trim(ncname), fmin, fmax
850# ifdef CHECKSUM
851 WRITE (stdout,50) fhash
852# endif
853 END IF
854 END IF
855
856 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
857 CALL exchange_r3d_tile (ng, tile, &
858 & lbi, ubi, lbj, ubj, 1, n(ng), &
859 & clima(ng) % Tnudgcof(:,:,:,ic))
860 END IF
861 END IF
862 END DO
863# ifdef DISTRIBUTE
864 IF (any(lnudgetclm(:,ng))) THEN
865 CALL mp_exchange4d (ng, tile, model, 1, &
866 & lbi, ubi, lbj, ubj, 1, n(ng), 1, ntclm(ng), &
867 & nghostpoints, &
868 & ewperiodic(ng), nsperiodic(ng), &
869 & clima(ng) % Tnudgcof)
870 END IF
871# endif
872# endif
873
874 10 FORMAT (/,' GET_NUDGCOEF_PIO - unable to open nudging NetCDF', &
875 & ' file: ',a)
876 20 FORMAT (/,' GET_NUDGCOEF_PIO - unable to find nudging', &
877 & ' variable: ',a,/,20x,'in NetCDF file: ',a)
878 30 FORMAT (/,' GET_NUDGCOEF_PIO - unable to find nudging', &
879 & ' variable: ',a, &
880 & /,20x,'or generic nudging variable: ',a, &
881 & /,20x,'in nudging NetCDF file: ',a)
882 40 FORMAT(2x,' GET_NUDGCOEF_PIO - ',a,/,21x, &
883 & '(Grid = ',i2.2,', File: ',a,')',/,21x, &
884 & '(Min = ', 1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
885# ifdef CHECKSUM
886 50 FORMAT (19x,'(CheckSum = ',i0,')')
887# endif
888
889 RETURN
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
type(var_desc_t), dimension(:), pointer var_desc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar